运行时错误 - excel VBA 中的2147024894错误

问：

我正在使用两个宏通过 gmail 的附件发送电子邮件。单独使用，01 用于设置一把剑 （PDF Atachment） 02.用于发送电子邮件。它们在单独使用时可以正常工作。但我试图将它们组合为一个宏，并且在运行时显示运行时错误**-2147024894系统找不到指定的文件**

我的组合代码：

Option Explicit
'For Early Binding, enable Tools > References > Microsoft CDO for Windows 2000 Library
Sub SendEmailUsingGmail_Welser()
       
    With Application
        .Calculation = xlCalculationManual
        .DisplayAlerts = True
        .DisplayStatusBar = True
    End With
                
    Dim NewMail As Object, mailConfig As Object, fields As Variant, msConfigURL As String, last_row As Long
    Dim attachment_path As String, j As Long, Attach_01 As String, AttachExists_01 As String
    Dim em As Worksheet
    Dim sn As Long
    Dim sn2 As Long
    Dim Attach As String
    Dim AttachExists As String
    
    Set em = ThisWorkbook.Sheets("Email")
    last_row = em.Range("B4").End(xlDown).Row
    ''last_row = em.Range("B2000").End(xlUp).Row
    
        
    For j = 4 To last_row
    
    Attach = "C:\Users\User\Desktop\Maling Payadvice\With Gmail 01\PaySlips\" & em.Cells(j, 2).Value & "*N.pdf"
    AttachExists = Dir(Attach)
   
    ''''' If Without Attachment '''''
    
    If AttachExists = "" Then
    GoTo NextID
    
    ElseIf em.Cells(j, 7).Value = "" Then
    GoTo NextID
                
    ElseIf em.Cells(j, 7).Value = 0 Then
    GoTo NextID
    
    End If
      
    ''''' Set Passwor to PDF Files '''''''
    Dim filepath_01 As String
    Dim filename_01 As String
    Dim fullname_01 As String
    Dim retval As String
    
    Dim FileOrigine As String, FileDestinazione As String
    Dim MyPwd As String, strParam As String
    
    
    filepath_01 = "C:\Users\User\Desktop\Maling Payadvice\With Gmail 01\PaySlips\"
    filename_01 = em.Cells(j, "B")
    FileOrigine = filepath_01 & filename_01 & "N.pdf"
    
    MyPwd = em.Cells(j, "H").Value
    FileDestinazione = filepath_01 & filename_01 & ".pdf"
    
    FileOrigine = """" & FileOrigine & """"
        FileDestinazione = """" & FileDestinazione & """"
        MyPwd = """" & MyPwd & """"
        
        strParam = FileOrigine _
                 & " Output " & FileDestinazione _
                 & " User_pw " & MyPwd _
                 & " Allow AllFeatures"
        
    retval = Shell("C:\Program Files (x86)\PDFtk\bin\pdftk.exe " & strParam, 0) '<<=== Percorso da adattare N.B. lo spazio dopo pdftk.exe
                        
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
       
    Attach_01 = "C:\Users\User\Desktop\Maling Payadvice\With Gmail 01\PaySlips\" & em.Cells(j, "B").Value & ".pdf"
            
    '''If Without Attachment '''''
    
    ''AttachExists_01 = Dir(Attach_01)
    
    ''If AttachExists_01 = "" Then

    ''MsgBox "No Attachment for PF No.  " & ws6.Cells(j, 2).Value & " - " & ws6.Cells(j, 3).Value

    ''GoTo NextID

    ''End If
            
    On Error GoTo Err:

    'late binding
    Set NewMail = CreateObject("CDO.Message")
    Set mailConfig = CreateObject("CDO.Configuration")

    ' load all default configurations
    mailConfig.Load -1

    Set fields = mailConfig.fields
    
    'Set All Email Properties
    With NewMail
        .From = "[email protected]"
        .To = em.Cells(j, 7).Value
        .CC = ""
        .BCC = ""
        .Subject = "Salary Slip For the Month of   " & em.Range("D1").Value
        .TextBody = "Dear  " & em.Cells(j, 3).Value & "," & vbNewLine & vbNewLine & "Please find your attached salary slip for the month of  " & em.Range("D1").Value & "." & vbNewLine & vbNewLine & "To open it, you are supposed to type your birth year and month without spaces as the password." & vbNewLine & "(Ex: if your year of birth is 1985 and month is june, your password would be 198506)" & vbNewLine & vbNewLine & "For any assistance, please contact 070-6702525 - Payroll Unit" & vbNewLine & vbNewLine & "Best Regards," & vbNewLine & vbNewLine & "I.W. Karunarathna," & vbNewLine & "Accountant (Payment & Payroll)," & vbNewLine & "Lakvijaya Power Station."
        .AddAttachment Attach_01
        
    End With

    msConfigURL = "http://schemas.microsoft.com/cdo/configuration"

    With fields
        .Item(msConfigURL & "/smtpusessl") = True             'Enable SSL Authentication
        .Item(msConfigURL & "/smtpauthenticate") = 1          'SMTP authentication Enabled
        .Item(msConfigURL & "/smtpserver") = "smtp.gmail.com" 'Set the SMTP server details
        .Item(msConfigURL & "/smtpserverport") = 465          'Set the SMTP port Details
        .Item(msConfigURL & "/sendusing") = 2                 'Send using default setting
        .Item(msConfigURL & "/sendusername") = "[email protected]" 'Your gmail address
        .Item(msConfigURL & "/sendpassword") = "zolb xrkc cwko ones" 'Your password or App Password
        .Update                                               'Update the configuration fields
    End With
    
    NewMail.Configuration = mailConfig
    NewMail.Send
    
                    '''' Status Bar'''''''
                    
Application.StatusBar = "Progress:  " & "PF No. : " & em.Cells(j, 2).Value & "   " & j - 3 & " of " & last_row - 3 & "   : " & Format((j - 3) / (last_row - 3), "0%")
    
                     '''''Status'''''''''
   
    If em.Cells(j, 7).Value = "" Then
    em.Cells(j, 9).Value = " No Sent"
    
    ElseIf em.Cells(j, 7).Value = 0 Then
    em.Cells(j, 9).Value = " No Sent"
    
    ElseIf AttachExists = "" Then
    em.Cells(j, 9).Value = " No Sent"
        
    Else
    
    em.Cells(j, 9).Value = "Sent"
    
    End If
    
Application.Wait (Now + TimeValue("0:00:01"))
                 
Next j

    With Application
        .Calculation = xlCalculationAutomatic
        .DisplayAlerts = True
        .DisplayStatusBar = False
    End With
    
    Kill ("C:\Users\User\Desktop\Maling Payadvice\With Gmail 01\PaySlips\" & em.Cells(j, 2).Value & "*N.pdf")
        
    MsgBox "All email has been sent", vbInformation
    
NextID:
          
Exit_Err:
    'Release object memory
    Set NewMail = Nothing
    Set mailConfig = Nothing
    End

Err:
    Select Case Err.Number
    Case -2147220973  'Could be because of Internet Connection
        MsgBox "Check your internet connection." & vbNewLine & Err.Number & ": " & Err.Description
    Case -2147220975  'Incorrect credentials User ID or password
        MsgBox "Check your login credentials and try again." & vbNewLine & Err.Number & ": " & Err.Description
    Case Else   'Report other errors
        MsgBox "Error encountered while sending email." & vbNewLine & Err.Number & ": " & Err.Description
    End Select

    Resume Exit_Err
            
End Sub

代码的第一部分用于设置PDF文件的密码，第二部分用于发送带有附件的邮件。我的文件路径是正确的。最后，我尝试删除以下代码，

Attach_01 = “C：\Users\User\Desktop\Maling Payadvice\With Gmail 01\PaySlips” & em.细胞（j， “B”）。值 & “.pdf”

然后运行代码和软件发送邮件，并带有附件。

请帮我解决这个问题。

普里扬塔