Question

我正在尝试发送一封包含五个附件的电子邮件，而不是五封包含五个附件的电子邮件。

发送功能：

Function SendFilesToEmail(strRecipients As String, strSubject As String, strBody As String)

    Dim objEmail As Object
    Set objEmail = CreateObject("CDO.Message")
    
    objEmail.FROM = "EMAIL"                          'Set Body for mail
    objEmail.To = strRecipients                                  'Set Recipient
    objEmail.Subject = strSubject                                'Set Subject
    objEmail.Textbody = strBody
    folderReports = "\\ FOLDER...\"
    Set objFSO = CreateObject("Scripting.FileSystemObject") 'if microsoft scripting runtime library activated not needed
    Set reportFolder = objFSO.GetFolder(folderReports)
    
    For Each ReportFile In reportFolder.Files
    
         If ReportFile.Name Like "*.xlsx" Then
            fileName = folderReports & ReportFile.Name
            objEmail.AddAttachment fileName
         End If
    
    Next ReportFile
    objEmail.Configuration.Fields.Item("http://schemas.microsoft.com/cdo/configuration/sendusing") = 2
    objEmail.Configuration.Fields.Item("http://schemas.microsoft.com/cdo/configuration/smtpserver") = "EMAILSERVER"
    objEmail.Configuration.Fields.Item("http://schemas.microsoft.com/cdo/configuration/smtpserverport") = ..
    objEmail.Configuration.Fields.Update
    objEmail.Send
    
End Function

这会循环浏览文件并调用发送电子邮件的电子邮件：

Sub MakroTest()
    Dim ReportFile As Object
    Dim currentReportFile As String
    
    Set objFSO = CreateObject("Scripting.FileSystemObject") 'if microsoft scripting runtime library activated not needed
    Set reportFolder = objFSO.GetFolder(folderReports)
    
    For Each ReportFile In reportFolder.Files
    
         If ReportFile.Name Like "*.xlsx" Then
            currentReportFile = folderReports & ReportFile.Name
            OpenFileAsTemp ReportFile.Name, currentReportFile
            Call Test2(ReportFile.Name)
            
            Call SaveFileAndSendEmail(ReportFile.Name)
         End If
    
    Next ReportFile

End Sub

订阅另一个用于发送电子邮件的模块：

Sub SaveFileAndSendEmail(workbookName As String)
    Dim filePath As String
    Set wbk = Workbooks(workbookName)
    Dim FilePathTo As String
    
    wbk.Close True
    
    filePath = "C:\tmp\" & workbookName
    FilePathTo = "\\FOLDER" & workbookName
    
    If Dir(FilePathTo) <> "" Then Kill FilePathTo
    FileCopy filePath, FilePathTo
    SendFilesToEmail "EMAILS", "Verpackung REPORT", "Report is sent."
    
End Sub

这将创建包含五个文件的五个电子邮件。我想要一封包含五个文件的电子邮件。

Answer 1

该代码两次遍历文件夹中的所有.xlsx文件。首先，您可以在SendFilesToEmail子目录中看到循环：

For Each ReportFile In reportFolder.Files
         If ReportFile.Name Like "*.xlsx" Then

然后在MacroTest子目录中可以找到相同的语句：

For Each ReportFile In reportFolder.Files
         If ReportFile.Name Like "*.xlsx" Then

因此，您需要从代码中排除一个循环。

发送一封包含多个附件的电子邮件

1 个答案: