0

我有一个 VBA 代码块，它应该发送多封带有附件的电子邮件（附件与宏在同一个文件夹中，宏根据它们的名称选择要发送的正确文件）。问题是在一月更新后，当我尝试执行代码时出现以下错误：“运行时错误 52”：错误的文件名或编号。调试器在“If Dir(newpth)”行显示错误。这似乎是与文件路径有关的错误，但我的 VBA 知识非常有限，所以我没有找到解决方案。

你可以看到下面的代码

Sub send_email()

Dim wb As Workbook
Dim sh As Worksheet
Dim sh1 As Worksheet

Dim OutApp As Outlook.Application
Dim outmail As Outlook.MailItem

Set wb = ThisWorkbook
Set sh = wb.Sheets("Data")
Set sh1 = wb.Sheets("Param")
locatie = wb.Path & "\"

lr = sh.Cells(1, 1).End(xlDown).Row

For Each a In sh.Range("A2:A" & lr)

newpth = locatie & a.Value & ".xlsx"

If Dir(newpth) <> "" Then  
    Set OutApp = CreateObject("Outlook.Application")
    Set outmail = OutApp.CreateItem(0)
    
    dela = sh1.Range("E2").Value
    becece = sh1.Range("E3").Value
    subiect = "(Ck-" & sh1.Range("G3").Value & " / " & a.Offset(0, 0).Value & ") " & sh1.Range("E4").Value & " - " & a.Offset(0, 1).Value
    introd = sh1.Range("E5").Value
    corp = sh1.Range("E6").Value
    semnat = sh1.Range("E7").Value
    cadavru = introd & vbNewLine & vbNewLine & corp & vbNewLine & vbNewLine & semnat

    On Error Resume Next
    With outmail
        .SentOnBehalfOfName = dela
        .To = a.Offset(0, 2).Value
        .BCC = becece
        .Subject = subiect
        .Body = cadavru
        .Attachments.Add newpth
        .Send
    End With
    On Error GoTo 0
    Else
    End If

Next

Set outmail = Nothing
Set OutApp = Nothing

End Sub

如果您有任何建议，我将很高兴听到它们。

4

0 回答 0