[RESOLVED] [EXCEL] Attach multiple files in Outlook

[the14th]

Hi,

The title may be confusing but I'm using Excel to attach files to an Outlook email.

Anyway, here's how it goes..

I have several files in a folder and I want to be able to in a click of a button (Email Reports) will send an email attaching all the files in a folder without having to specify the files one by one.

Is there a way to do this because I cannot guarantee that the exact file names will be in the folder. It may change from time to time and I just want to automatically attach whatever files are in the folder.

This is what I have which obviously would not run:

Private Sub CommandButton1_Click()

Dim oApp As Outlook.Application
Set oApp = New Outlook.Application
Dim oMsg As MailItem
Dim oAttachment As Outlook.Attachment

Set oMsg = oApp.CreateItem(olMailItem)

oMsg.SentOnBehalfOfName = "CSS"
oMsg.To = ThisWorkbook.Sheets("Sheet1").Range("C15").Value
oMsg.CC = "CSS"
oMsg.Subject = ThisWorkbook.Sheets("Sheet1").Range("B6").Value
oMsg.Body = ThisWorkbook.Sheets("Sheet1").Range("B10").Value

Set oAttachment = oMsg.Attachments.Add("C:\Documents and Settings\NC\Desktop\test\")

oMsg.Save

Set oMsg = Nothing

Set oApp = Nothing

End Sub

Any help will be very helpful!

Thank you!

[Siddharth Rout]

Is this what you are trying?

'~~> Add Reference to MS Outlook xx.xx Library
Sub Example()
    Dim oOutlook As Outlook.Application, oEmailItem As MailItem
    Dim strDir As String, strFile As String, colFiles As New Collection
    Dim i As Integer
    
    On Error Resume Next
    Set oOutlook = GetObject(, "Outlook.Application")
    If oOutlook Is Nothing Then Set oOutlook = CreateObject("Outlook.Application")
    On Error GoTo 0
    
    '~~> Sample Directory
    strDir = "C:\Documents and Settings\NC\Desktop\test\"
    strFile = Dir(strDir)
    
    '~~> Add all files in that directory to a collection
    While strFile <> ""
        colFiles.Add strFile
        strFile = Dir
    Wend
    
    Set oEmailItem = oOutlook.CreateItem(olMailItem)

    With oEmailItem
        '~~> Add files in the collections as attachments
        If colFiles.Count > 0 Then
            For i = 1 To colFiles.Count
                .Attachments.Add strDir & colFiles(i)
            Next i
        End If
        
        .To = ThisWorkbook.Sheets("Sheet1").Range("C15").Value
        .Subject = ThisWorkbook.Sheets("Sheet1").Range("B6").Value
        .Body = ThisWorkbook.Sheets("Sheet1").Range("B10").Value
        .Display
    End With

    Set oEmailItem = Nothing
    Set oOutlook = Nothing
End Sub

[the14th]

That's amazingly correct!

Thank you so much!