Question

对不起，我对VBA很新。我有一个vba，它创建一个电子邮件，将文件附加到电子邮件，然后发送。如果文件存在于文件夹中，它将完美地工作。我的问题是可能并不总是要附加文件。这是每日电子邮件，1位收件人将出现在今天的电子邮件列表中，但不是明天。

所以我有一个供应商列表。我希望VBA遍历列表的每一行。创建电子邮件，附加文件并发送电子邮件。在大多数情况下，VBA都有效。期望文件不在文件夹中。如果文件不在文件夹中，我希望VBA继续下一行而不是停止。

Sub sendEmailWithAttachments()

Dim OutLookApp As Object
Dim OutLookMailItem As Object
Dim myAttachments As Object
Dim row As Integer
Dim col As Integer

Set OutLookApp = CreateObject("Outlook.application")
row = 2
col = 1
ActiveSheet.Cells(row, col).Select
Do Until IsEmpty(ActiveCell)
    Set OutLookMailItem = OutLookApp.CreateItemFromTemplate(Application.ActiveWorkbook.Path & "\" & "message.oft")
    Set myAttachments = OutLookMailItem.Attachments
    'Do Until IsEmpty(ActiveCell)
    Do Until IsEmpty(ActiveSheet.Cells(1, col))
        With OutLookMailItem
            If ActiveSheet.Cells(row, col).Value = "xxxFINISHxxx" Then
                'MsgBox ("Exiting...")
                Exit Sub
            End If
            If ActiveSheet.Cells(1, col).Value = "To" And Not IsEmpty(ActiveCell) Then
                .To = .To & "; " & ActiveSheet.Cells(row, col).Value
            ElseIf ActiveSheet.Cells(1, col).Value = "Cc" And Not IsEmpty(ActiveCell) Then
                .CC = .CC & "; " & ActiveSheet.Cells(row, col).Value
            ElseIf ActiveSheet.Cells(1, col).Value = "Bcc" And Not IsEmpty(ActiveCell) Then
                .BCC = .BCC & "; " & ActiveSheet.Cells(row, col).Value
            ElseIf ActiveSheet.Cells(1, col).Value = "attachment" And Not IsEmpty(ActiveCell) Then
              myAttachments.Add Application.ActiveWorkbook.Path & "\" & ActiveSheet.Cells(row, col).Value
            ElseIf ActiveSheet.Cells(1, col).Value = "xxxignorexxx" Then
                ' Do Nothing
            Else
                .Subject = Replace(.Subject, ActiveSheet.Cells(1, col).Value, ActiveSheet.Cells(row, col).Value)
                'Write #1, .HTMLBody
                .HTMLBody = Replace(.HTMLBody, ActiveSheet.Cells(1, col).Value, ActiveSheet.Cells(row, col).Value)
                'ActiveSheet.Cells(10, 10) = .HTMLBody
            End If

            'MsgBox (.To)
        End With
        'Application.Wait (Now + #12:00:01 AM#)

        col = col + 1
        ActiveSheet.Cells(row, col).Select

    Loop
    OutLookMailItem.HTMLBody = Replace(OutLookMailItem.HTMLBody, "xxxNLxxx", "<br>")
    OutLookMailItem.Send
    col = 1
    row = row + 1
    ActiveSheet.Cells(row, col).Select
Loop

End Sub

Answer 1

尝试：

首先：声明一个新变量

Dim sFile As String

然后：替换

ElseIf ActiveSheet.Cells(1, col).Value = "attachment" And Not IsEmpty(ActiveCell) Then
          myAttachments.Add Application.ActiveWorkbook.Path & "\" & ActiveSheet.Cells(row, col).Value

使用：

ElseIf ActiveSheet.Cells(1, col).Value = "attachment" And Not IsEmpty(ActiveCell) Then
            If Not Dir(Application.ActiveWorkbook.Path & "\" & ActiveSheet.Cells(row, col).Value) = "" Then
                myAttachments.Add Application.ActiveWorkbook.Path & "\" & ActiveSheet.Cells(row, col).Value
            Else
                MsgBox "Please, select a file."
                sFile = Application.GetOpenFilename
                If Not sFile = "" Then
                    myAttachments.Add sFile
                End If
            End If

如果Macro无法找到附件，请不要创建电子邮件并转到下一行

1 个答案: