Results 1 to 1 of 1

E-mail with multiple attachments

Threaded View

  1. #1
    Forum Contributor
    Join Date
    02-20-2009
    Location
    Manchester, England
    MS-Off Ver
    Excel 2007
    Posts
    467

    E-mail with multiple attachments

    I have the following code as part of a macro which sets up an e-mail with a temporary .xls file attached. What i want to do is amend/add to the code something that copies another worksheet (called "epos") in my workbook and also adds this as a seperate csv attachment called "epos".

    'E-MAILS SHEET
          Dim ans As String
    ans = MsgBox("e-mail prices to studio/teletext?", vbYesNo + vbQuestion, "E-mail?")
    If ans = vbYes Then
    
        Sheets("Selection").Select
    
                  
        'Working in 2000-2007
        Dim FileExtStr As String
        Dim FileFormatNum As Long
        Dim Sourcewb As Workbook
        Dim Destwb As Workbook
        Dim TempFilePath As String
        Dim TempFileName As String
        Dim OutApp As Object
        Dim OutMail As Object
    
        With Application
            .ScreenUpdating = False
            .EnableEvents = False
        End With
    
        Set Sourcewb = ActiveWorkbook
    
        'Copy the sheet to a new workbook
        ActiveSheet.Copy
        Set Destwb = ActiveWorkbook
      
    
        'Determine the Excel version and file extension/format
        With Destwb
            If Val(Application.Version) < 12 Then
                'You use Excel 2000-2003
                FileExtStr = ".xls": FileFormatNum = -4143
            Else
                'You use Excel 2007, we exit the sub when your answer is
                'NO in the security dialog that you only see  when you copy
                'an sheet from a xlsm file with macro's disabled.
                If Sourcewb.Name = .Name Then
                    With Application
                        .ScreenUpdating = True
                        .EnableEvents = True
                    End With
                    MsgBox "Your answer is NO in the security dialog"
                    Exit Sub
                Else
                    Select Case Sourcewb.FileFormat
                    Case 51: FileExtStr = ".xlsx": FileFormatNum = 51
                    Case 52:
                        If .HasVBProject Then
                            FileExtStr = ".xlsm": FileFormatNum = 52
                        Else
                            FileExtStr = ".xlsx": FileFormatNum = 51
                        End If
                    Case 56: FileExtStr = ".xls": FileFormatNum = 56
                    Case Else: FileExtStr = ".xlsb": FileFormatNum = 50
                    End Select
                End If
            End If
        End With
    
        '    'Change all cells in the worksheet to values if you want
        '    With Destwb.Sheets(1).UsedRange
        '        .Cells.Copy
        '        .Cells.PasteSpecial xlPasteValues
        '        .Cells(1).Select
        '    End With
        '    Application.CutCopyMode = False
    
        'Save the new workbook/Mail it/Delete it
        TempFilePath = Environ$("temp") & "\"
        TempFileName = "Golf Matches"
    
        Set OutApp = CreateObject("Outlook.Application")
        OutApp.Session.Logon
        Set OutMail = OutApp.CreateItem(0)
    
        With Destwb
            .SaveAs TempFilePath & TempFileName & FileExtStr, _
                    FileFormat:=FileFormatNum
            On Error Resume Next
            With OutMail
                .To = ""
                .CC = ""
                .BCC = ""
                .Subject = "Golf Matches" & "  ***"
                .Body = ""
                .Attachments.Add Destwb.FullName
                'You can add other files also like this
                '.Attachments.Add ("C:\test.txt")
                .Display   'or use .Send
            End With
            On Error GoTo 0
            .Close SaveChanges:=False
        End With
    
        'Delete the file you have send
        Kill TempFilePath & TempFileName & FileExtStr
    
        Set OutMail = Nothing
        Set OutApp = Nothing
    
        With Application
            .ScreenUpdating = True
            .EnableEvents = True
        End With
    
        Windows("Golf Matches Upload.xls").Activate
        Sheets("Input Sheet").Select
        Range("M3").Select
        
        Else
    
        Sheets("Input Sheet").Select
        Range("M3").Select
        
    End If
    Any help much appreciated.

    Thanks,
    Adam.
    Last edited by adam2308; 11-05-2009 at 08:39 AM.

Thread Information

Users Browsing this Thread

There are currently 1 users browsing this thread. (0 members and 1 guests)

Bookmarks

Posting Permissions

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

Search Engine Friendly URLs by vBSEO 3.6.0 RC 1