上的错误转到环路

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