Пропуск электронной почты без вложений - PullRequest
2 голосов
/ 10 февраля 2020

Мне нужна ваша помощь, чтобы сделать это! Я ничего не знаю о VBA, но просматриваю inte rnet Я создаю файл Excel с макросом для отправки электронной почты на разные адреса с различными вложениями к каждому письму.

Сейчас рассылка работает нормально, но только если все файлы существуют. Адреса файлов определяются автоматически, и каждый месяц я отправляю различные электронные письма с 2 или 3 вложенными файлами, но бывают месяцы, когда файл не имеет файла, поэтому VBA не генерирует электронную почту.

Что мне нужно, так это даже если файл не существует, создайте электронное письмо с существующим и перейдите к следующему электронному письму.

Код такой:

Sub send_email_with_multiple_attachments()

On Error Resume Next

Dim o As Outlook.Application
Set o = New Outlook.Application
Dim omail As Outlook.MailItem

Dim i As Long

For i = 2 To Range("c100").End(xlUp).Row
    Set omail = o.CreateItem(olMailltem)
    With omail
        .Body = "Caro cliente " & Cells(i, 2).Value
        .To = Cells(i, 3).Value
        .CC = Cells(i, 4).Value
        .Subject = Cells(i, 5).Value
        .Attachments.Add Cells(i, 6).Value
        .Attachments.Add Cells(i, 7).Value
        .Attachments.Add Cells(i, 8).Value
        .Attachments.Add Cells(i, 9).Value
        .Attachments.Add Cells(i, 10).Value
        .Display
    End With
Next

End Sub

1 Ответ

0 голосов
/ 10 февраля 2020

Вам необходимо проверить содержимое ячейки, прежде чем добавлять ее в качестве вложения. Посмотрите код ниже и просмотрите комментарии к коду:

Option Explicit

Sub send_email_with_multiple_attachments()

' section of all objects and parameters declaration
Dim o As Outlook.Application
Dim omail As Outlook.MailItem
Dim strFileExists As String
Dim i As Long, j As Long

Set o = New Outlook.Application

For i = 2 To Range("c100").End(xlUp).Row
    Set omail = o.CreateItem(olMailItem)
    With omail
        .Body = "Caro cliente " & Cells(i, 2).Value
        .To = Cells(i, 3).Value
        .CC = Cells(i, 4).Value
        .Subject = Cells(i, 5).Value

        ' add second loop to check all cells with possible attachments
        For j = 6 To 10
            ' make sure cells is not empty
            If (Cells(i, j).Value) <> "" Then
                strFileExists = Dir(Cells(i, j).Value) ' make sure file exits in current cell
                If strFileExists <> "" Then ' only if file exits add as attachment
                    .Attachments.Add Cells(i, j).Value
                End If
            End If
        Next j

        .Display
    End With
Next

End Sub
Добро пожаловать на сайт PullRequest, где вы можете задавать вопросы и получать ответы от других членов сообщества.
...