使用Outlook宏通过电子邮件发送文件 [英] Use an Outlook Macro to Send Files by Email

问题描述

使用宏代码将文件夹的所有文件附加到Microsoft Outlook电子邮件中

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 = "[e-mail]"
        .HTMLBody = "Hi " & olMsg.To & ", <br /><br /> I have attached " & fName & " as you requested."
        .Send
    End With
End Function

我正在发送0个文件，并且该文档未通过电子邮件传输到Microsoft Outlook

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

推荐答案

要将所有文件附加到一封电子邮件中，请尝试修改您的代码.

示例.

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 = "[e-mail]"
        .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

确保将FilesPath = Environ("USERPROFILE") & "\Desktop\FolderName\" FolderName更新为正确的文件夹名称.

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

您还可以使用FilesPath = "C:\Users\Om3r\Desktop\FolderName\"并确保更新Om3r和FolderName

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

这篇关于使用Outlook宏通过电子邮件发送文件的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持IT屋！