上的錯誤轉到環路

Question

我想創建一個循環，會去翻客戶的名單，如果有該客戶的一份報告，電子郵件客戶的報告。

我需要的是一個On Error語句，將允許客戶在不報告被跳過，並允許腳本繼續到下一個顧客的權利，直到客戶列表的末尾。

On Error語句我現在畢竟客戶一直循環通過卡住，並在On Error語句繼續循環。

任何幫助將不勝感激！

sub test() 

a = 2 

Check: 

    Do Until UniqueBuyer.Range("A" & a).Value = "" 

On Error GoTo ErrHandler: 

    Sheets(UniqueBuyer.Range("A" & a).Value).Activate 

     ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:= _ 
     FolderLocation & FolderName & "\" & _ 
     UniqueBuyer.Range("A" & a).Value & ".pdf" _ 
     , Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas _ 
     :=Flase, OpenAfterPublish:=False 
     PDFFile = FolderLocation & FolderName & "\" & _ 
     UniqueBuyer.Range("A" & a).Value & ".pdf" 

      Set OutLookApp = CreateObject("Outlook.Application") 
      Set OutlookMail = OutLookApp.createItem(0) 
      CombinedEmail = "" 
      'Clear variable - LK 
      On Error Resume Next 
      'Display email and specify To, Subject, etc 
      With OutlookMail 

       .Display 
       c = 4 
       Do Until UniqueBuyer.Cells(a, c).Value = "" 
       AdditionalEmail = UniqueBuyer.Cells(a, c) 
       CombinedEmail = CombinedEmail & ";" & AdditionalEmail 
       .to = CombinedEmail 
       c = c + 1 
       Loop 

       .cc = "" 
       .BCC = "" 
       .Subject = "Weekly Wooltrade Summary " & Left(Master.Range("X2"), 3) 
       .Body = "" 
       .Attachments.Add PDFFile 
       '.Send 

      End With 

      On Error GoTo 0 

a = a + 1 

Loop 
Exit Sub 

ErrHandler: 

a = a + 1 
GoTo Check 

End Sub 

Answer 1

的On Error GoTo方式是很難一去：你最好檢查是否有任何可能的錯誤，並處理它

而且你也能更好實例化一個Outlook應用程序僅適用於所有需要的電子郵件

終於有一些錯別字（Flase - >False）

這裏是一個可能的（註釋）代碼的上面什麼重構：

Option Explicit 

Sub test() 
    Dim UniqueBuyer As Worksheet, Master As Worksheet 
    Dim FolderLocation As String, FolderName As String, PDFFile As String 
    Dim OutLookApp As Object 
    Dim cell As Range 

    FolderLocation = "C:\Users\...\" '<--| change it to your actual folder location 
    FolderName = "Test" '<--| change it to your actual folder name 

    Set UniqueBuyer = Worksheets("UniqueBuyer") '<--| change "UniqueBuyer" to your actual Unique Buyer sheet name 
    Set Master = Worksheets("Master") '<--| change "Master" to your actual Master sheet name 

    Set OutLookApp = CreateObject("Outlook.Application") '<--| set one Outlook application outside the loop 

    With UniqueBuyer '<--| reference your "Unique Buyer" sheet 
     For Each cell In .Range("A2", .Cells(.Rows.Count, 1).End(xlUp)).SpecialCells(xlCellTypeConstants, xlTextValues) '<--| loop through its column A cells with constant (i.e. not from formulas) text content from row 2 down to last not empty one 
      PDFFile = FolderLocation & FolderName & "\" & cell.Value & ".pdf" '<--| build your PDF file name 
      With .Range(cell.Offset(, 3), cell.Offset(, 3).End(xlToRight)) '<--| reference current buyer cells from column 4 rightwards 
       If WorksheetFunction.CountA(.Cells) > 0 Then '<--| if any not-blank cells in referenced ones 
        If OKSheetAndExportToPDF(cell.Value, PDFFile) Then '<--| if successfully found current buyer sheet and exported it to PDF 
         'Display email and specify To, Subject, etc 
         With OutLookApp.createItem(0) '<--| create a new mail item and reference it 
          .Display 
          .to = GetCombinedEmails(.SpecialCells(xlCellTypeConstants, xlTextValues)) '<--| get emails string from currently referenced cells with some constant text value 
          .cc = "" 
          .BCC = "" 
          .Subject = "Weekly Wooltrade Summary " & Left(Master.Range("X2"), 3) 
          .Body = "" 
          .Attachments.Add PDFFile 
          '.Send 
         End With 
        End If 
       End If 
      End With 
     Next 
    End With 

    Set OutLookApp = Nothing 
End Sub 

Function GetCombinedEmails(rng As Range) As String 
    Dim cell As Range 
    With rng 
     If .Count = 1 Then 
      GetCombinedEmails = .Value 
     Else 
      GetCombinedEmails = Join(Application.Transpose(Application.Transpose(.Value)), ";") '<--| join all found consecutive email addresses in one string 
     End If 
    End With 
End Function 

Function OKSheetAndExportToPDF(shtName As String, PDFFile As String) As Boolean 
    On Error GoTo ExitFunction 
    With Worksheets(shtName) 
     .ExportAsFixedFormat Type:=xlTypePDF, _ 
      Filename:=PDFFile, _ 
      Quality:=xlQualityStandard, _ 
      IncludeDocProperties:=True, _ 
      IgnorePrintAreas:=False, _ 
      OpenAfterPublish:=False 
     OKSheetAndExportToPDF = True 
    End With 
ExitFunction: 
End Function