Results 1 to 2 of 2

Thread: Newbie:send via email entire WorkBook with all macros within,not only ActiveSheeet

  1. #1

    Thread Starter
    New Member
    Join Date
    Apr 2013
    Posts
    1

    Exclamation Newbie:send via email entire WorkBook with all macros within,not only ActiveSheeet

    Hi dears,

    I'm just starting getting interested about VBAs and excel macro, and I combined a macro in order to send an excel file for approval/rejection. Everything works, with the only problem that what is sent is only the active Worksheet. In this way, the addressee will not be able to approve/reject by pressing the form button I prepared, therefore the file is useless.
    I need to send instead the full excel file together with the macros I wrote.

    This is the code I prepared:
    Option Explicit
    Sub Mail_Approve_and_Send()
    'Working in Excel 2000-2013
    'Developed by Francesco Addario
    Dim sh As Worksheet
    Dim wb As Workbook
    Dim FileExtStr As String
    Dim FileFormatNum As Long
    Dim TempFilePath As String
    Dim TempFileName As String
    Dim OutApp As Object
    Dim OutMail As Object

    TempFilePath = Environ$("temp") & "\"

    If Val(Application.Version) < 12 Then
    'You use Excel 97-2003
    FileExtStr = ".xls": FileFormatNum = -4143
    Else
    'You use Excel 2007-2013
    FileExtStr = ".xlsm": FileFormatNum = 52
    End If

    With Application
    .ScreenUpdating = False
    .EnableEvents = False
    End With

    Set OutApp = CreateObject("Outlook.Application")

    For Each sh In ThisWorkbook.Worksheets
    If sh.Range("m2").Value Like "?*@?*.?*" Then

    sh.Copy
    Set wb = ActiveWorkbook

    TempFileName = "Sheet " & sh.Name & " of " _
    & ThisWorkbook.Name & " " & Format(Now, "dd-mmm-yy h-mm-ss")

    Set OutMail = OutApp.CreateItem(0)

    With wb
    .SaveAs TempFilePath & TempFileName & FileExtStr, FileFormat:=FileFormatNum

    On Error Resume Next
    With OutMail
    'Adreessee obtained by comparing who is the current user, then go to the next one
    .to = sh.Range("m2").Value
    'CC if in cell e6, since IA Specialist is in C6
    .CC = sh.Range("e6").Value
    .BCC = ""
    'Send the automatically compiled text in i4
    .Subject = sh.Range("j4").Value
    'Send the automatically compiled text in i5
    .Body = sh.Range("j5").Value
    .Attachments.Add wb.FullName
    'You can add other files also like this
    '.Attachments.Add ("C:\test.txt")
    .Send
    End With
    On Error GoTo 0

    .Close savechanges:=False
    End With

    Set OutMail = Nothing

    Kill TempFilePath & TempFileName & FileExtStr

    End If
    Next sh

    Set OutApp = Nothing

    With Application
    .ScreenUpdating = True
    .EnableEvents = True
    End With
    End Sub
    Could you please help me? Where is the mistake?

    Thanks a lot!

  2. #2
    PowerPoster
    Join Date
    Dec 2004
    Posts
    25,618

    Re: Newbie:send via email entire WorkBook with all macros within,not only ActiveSheee

    For Each sh In ThisWorkbook.Worksheets
    If sh.Range("m2").Value Like "?*@?*.?*" Then

    sh.Copy
    Set wb = ActiveWorkbook
    this appears to copy each sheet, matching criteria, into a new workbook, then that would then be the active workbook, which is copied and sent
    if you want to send the entire workbook set wb before the loop as the whole workbook and remove the sh.copy line, unless it is used for someother purpose
    i do my best to test code works before i post it, but sometimes am unable to do so for some reason, and usually say so if this is the case.
    Note code snippets posted are just that and do not include error handling that is required in real world applications, but avoid On Error Resume Next

    dim all variables as required as often i have done so elsewhere in my code but only posted the relevant part

    come back and mark your original post as resolved if your problem is fixed
    pete

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •  



Click Here to Expand Forum to Full Width