Use an Outlook Macro to Send Files by Email

问题

Attaching all files of a folder to a Microsoft outlook email using a macro code

Dim fldName As String
Sub SendFilesbuEmail()
    ' From slipstick.me/njpnx
    Dim sFName As String

    i = 0

    fldName = "C:\Users\"

    sFName = Dir(fldName)

    Do While Len(sFName) > 0
        Call SendasAttachment(sFName)
        sFName = Dir
        i = i + 1
        Debug.Print fName
    Loop

    MsgBox i & " files were sent"
End Sub

Function SendasAttachment(fName As String)
    Dim olApp As Outlook.Application
    Dim olMsg As Outlook.MailItem
    Dim olAtt As Outlook.Attachments

    Set olApp = Outlook.Application
    Set olMsg = olApp.CreateItem(0) ' email
    Set olAtt = olMsg.Attachments

    ' attach file
    olAtt.Add (fldName & fName)

    ' send message
    With olMsg
        .Subject = "Here's that file you wanted"
        .To = "abcde@gmail.com"
        .HTMLBody = "Hi " & olMsg.To & ", <br /><br /> I have attached " & fName & " as you requested."
        .Send
    End With
End Function

I am getting 0 files sent and the document is not getting transferred to Microsoft outlook in the email

回答1:

To Attached all files into one Email, try modifying your code.

Example.

Option Explicit
Dim FilesPath As String
Sub SendFilesbuEmail()
    Dim File As String
    Dim i As Long

    FilesPath = Environ("USERPROFILE") & "\Desktop\"
    'FilesPath = "C:\Users\Om3r\Desktop\FolderName\"
    File = Dir(FilesPath)

    Call SendasAttachment(File)

End Sub

Function SendasAttachment(File As String)
    Dim olApp As Object ' Outlook.Application
    Dim olMsg As Object ' Outlook.MailItem
    Dim Atmts As Object ' Outlook.Attachments

    Dim i As Long

    Set olApp = CreateObject("Outlook.Application")
    Set olMsg = olApp.CreateItem(0) ' email
    Set Atmts = olMsg.Attachments
    i = 0

    ' send message
    With olMsg

        Do While Len(File) > 0
            Atmts.Add (FilesPath & File)
            File = Dir
            i = i + 1
        Loop
        .Display
        .Subject = "Here's that file you wanted"
        .To = "alias@domain.com"
        .HTMLBody = "Hi " & olMsg.To & ", <br /><br /> I hav attch Files"
    End With

    MsgBox i & " Files were sent"

    Set olMsg = Nothing
    Set Atmts = Nothing


End Function

Make sure to update FilesPath = Environ("USERPROFILE") & "\Desktop\FolderName\" FolderName to the correct folder name.

You can also use FilesPath = "C:\Users\Om3r\Desktop\FolderName\" and make sure to update Om3r and FolderName

来源：https://stackoverflow.com/questions/39165786/use-an-outlook-macro-to-send-files-by-email