Question

我不是专家，我想发送多个不同的附件（例如，Person1接收BOTH attch.1和attach.2; Person2接收attch.3和attch.5等）。

我的代码：

Sub SendEmail(what_address As String, subject_line As String, mail_body As String)

Dim dlApp As Outlook.Application
  Set olApp = CreateObject("Outlook.Application")

Dim olMail As Outlook.MailItem
  Set olMail = olApp.CreateItem(olMailItem)

  olMail.To = what_address
  olMail.Subject = subject_line
  olMail.Body = mail_body
  olMail.Send
End Sub

Sub SendMassEmail()
Dim mail_body_message As String
Dim title As String
  row_number = 1
  Do
    DoEvents
    row_number = row_number + 1

    mail_body_message = Sheet1.Range("D2")
    title = Sheet1.Range("B" & row_number)
    mail_body_message = Replace(mail_body_message, "replace_name_here", title)
    Call SendEmail(Sheet1.Range("A" & row_number), "This is a test", mail_body_message)
  Loop Until row_number = Sheet1.Cells(Rows.Count, 1).End(xlUp).Row
End Sub

Answer 1

我认为您的代码需要一些工作，但下面的代码段应该有助于添加多个附件。我试图添加可能有用的注释。

请注意，必须知道每个附件的完整路径。

例如： C：\ TestFolder \ TestSubfolder \ TESTFILE.TXT

您应该能够使用相同的循环概念遍历列以处理多个电子邮件。如果不知道电子表格的结构，就很难建议使用确切的循环。

Sub GenerateEmails()

Dim OutApp As Object
Dim OutMail As Object
Dim myRange As Range

Set OutApp = CreateObject("Outlook.Application")
Set OutMail = Outlook.Application.CreateItem(olMailItem)

'This will only generate a single email with multiple attachments.
'You will need another loop or something similar to process multiple emails the loop could
'be similar to the loop below that use offset to go down rows but instead
'you will offest across columns
With OutMail
        'I have used hard coded cell ranges to define the values but you can use other
        'methods.
        .Subject = Range("A1").Value
        .To = Range("A2").Value
        .CC = Range("A3").Value
        .Body = Range("A4").Value
        'This is where you list of attachments will start
        Set myRange = Range("A5")
        'Keep going down one cell until no more attachment values are provided
        Do Until myRange.Value = ""
            'The value here needs to be the full attachment path including file name and extension
            .Attachments.Add (myRange.Value)
            'Set the range to be the next cell down
            Set myRange = myRange.Offset(1, 0)
        Loop

        'This displays the email without sending.
        .Display
        'Once the code is correct you can use the .Send instead to actually send the emails.
End With

Set OutMail = Nothing
Set OutApp = Nothing


End Sub

通过VBA和Outlook发送多个和不同的附件

1 个答案: