VBA 已發送/未發送電子郵件的 IF 語句

Question

我正在使用下面的代碼告訴我電子郵件何時發送並顯示文本“已發送”，所以我知道沒有錯誤。 但是我正在測試代碼，並且在添加供應商名稱后使用 vlookup 來顯示電子郵件。 我的目標是不讓宏調試並讓它繼續下一個，但同時讓我知道一行有錯誤，因為該供應商沒有列出 email，我需要填寫email 在中。當我列出供應商時，我將一個單元格留空以測試代碼。 即使我有有效的電子郵件，並且那些發送的電子郵件 VBA 顯示“未發送”到已發送的電子郵件。 由於宏無法找到 email，因為其中一個單元格為空白，因此已對其進行了調試，並且在所有有效電子郵件旁邊填充了“未發送”文本。 我錯過了什么或做錯了什么？ 我只是想避免調試告訴我有一個錯誤，只是告訴我一行“未發送”，並繼續發送 rest 並用“已發送”文本填充那些發送。

Sub Send_Multiple_Emails()
dim sh as worksheet
set sh = thisworkbook.sheets("sheet1") <-- rename to what the tabs name is

dim OA as Object
Dim msg As object

set OA = createobject("Outlook.Application")

Dim i as integer
dim last_row As Integer

last_row = application.worksheetfunction.counta(sh.range("B:B"))

for i = 2 To last_row 
Set msg = OA.createitem(0)

msg.to = sh.Range("B" & i).Value
msg.cc = sh.Range("C" & i).Value
msg.subject = sh.range("D" & i ).Value
msg.body = sh.Range("E" & i).Value

if sh.Range("F" & i).Value <> "" Then
msg.attachments.add sh.range("F" & i).Value
End If

msg.send

**If Issent = True Then
Range("G" & i).Value = "Sent"
Else
Range("G" & i).Value = "Not Sent"
End If**

next i

msgbox "Mails Sent"

End Sub

Answer 1

請嘗試替換此代碼部分：

msg.send

If Issent = True Then
   Range("G" & i).Value = "Sent"
Else
   Range("G" & i).Value = "Not Sent"
End If

有了這個：

Dim Issent As Boolean
   
   On Error Resume Next
    msg.send
   If Err.Number <> 0 Then
      Err.Clear: On Error GoTo 0
      Issent = False
   Else
      On Error GoTo 0
      Issent = True
   End If
   
    If Issent = True Then
       Range("G" & i).Value = "Sent"
    Else
       Range("G" & i).Value = "Not Sent"
    End If

編輯：我不認為上面插入的行會打擾您的代碼流暢運行。 即使不是這個問題，請嘗試下一個改編的代碼。 它還處理要附加的文檔的最終錯誤路徑：

1. 添加對Microsoft Outlook... Object Library的引用。 在 VBE（Visual Basic 編輯器）中，go：工具（菜單）-> 參考...向下滾動直到找到上述參考。 檢查並按OK 。

2. 復制下一個代碼而不是你的代碼，或者在它附近（我將更改Sub名稱）並運行它：

    Sub Send_Multiple_Emails_bis()
     Dim sh As Worksheet, Issent As Boolean, i As Long, last_row As Long
     Dim OA As New Outlook.Application, msg As Outlook.MailItem
    
     Set sh = ActiveSheet ' ThisWorkbook.Sheets("sheet1")
    
     last_row = sh.Range("B" & Rows.count).End(xlUp).row
    
     For i = 2 To last_row
        Set msg = OA.CreateItem(0)
        With msg
            .To = sh.Range("B" & i).Value
            .cc = sh.Range("C" & i).Value
            .Subject = sh.Range("D" & i).Value
            .body = sh.Range("E" & i).Value
            '.display 'un-comment if you want to see each mail sending window
        End With
        
        If sh.Range("F" & i).Value <> "" Then
            If Dir(sh.Range("F" & i).Value) <> "" Then
                msg.Attachments.aDD sh.Range("F" & i).Value
            Else
                Range("G" & i).Value = "Wrong attachment path"
                GoTo NextMail
            End If
        End If
        
        On Error Resume Next
        msg.send
         If Err.Number <> 0 Then
            Err.Clear: On Error GoTo 0
            Issent = False
         Else
            On Error GoTo 0
            Issent = True
         End If
        
        If Issent = True Then
            Range("G" & i).Value = "Sent"
        Else
            Range("G" & i).Value = "Not Sent"
        End If
    NextMail:
        Set msg = Nothing
     Next i
    
     MsgBox "Mails Sent"
    End Sub

我想收到一些關於它的行為的反饋......