0

我正在尝试发送多个 pdf 文件（每次不同的数量）。

我有代码，它可以在不同的电子表格中附加一个文件，但在这个文件上不起作用，即使 pdf 是使用与附件相同的单元格中的名称创建的。

我有一个从第 14 行开始的“a”列中要附加的所有文件的列表（没有 pdf 扩展名），并且需要附加 1-10 个文件，直到单元格为空。

在其他地方工作的一个附件的代码：

Private Sub CommandButton1_Click()
    On Error GoTo ErrHandler
        
    ' SET Outlook APPLICATION OBJECT.
    Dim objOutlook As Object
    Set objOutlook = CreateObject("Outlook.Application")
        
    ' CREATE EMAIL OBJECT.
    Dim objEmail As Object
    Set objEmail = objOutlook.CreateItem(olMailItem)
    Dim Path As String
    Dim FileName1 As String
    
    Path = "C:\Users\File Folder\"
    FileName1 = Range("A14")
    
    PathFileName = ThisWorkbook.Path & "\" & FileName1 & ".pdf"
    
    With objEmail
        .SentOnBehalfOfName = "company@company.com"
        .To = "company@company.com"
        .Subject = FileName1
        .Body = "Have a nice day!"
    
        .Attachments.Add PathFileName
        .Display        ' Display the message in Outlook.
    End With
        
    ' CLEAR.
    Set objEmail = Nothing:    Set objOutlook = Nothing
            
ErrHandler:
    '
End Sub
4

1 回答 1

0

尝试这个：

Private Sub CommandButton1_Click()
    Const FLDR = "C:\Users\File Folder\" 'files are here
    Dim objOutlook As Object
    Dim objEmail As Object, cFile As Range
    Dim fPath As String
    
    On Error GoTo ErrHandler
    Set objOutlook = CreateObject("Outlook.Application") 'edit: fixed position
    Set objEmail = objOutlook.CreateItem(olMailItem)
    
    Set cFile = ActiveSheet.Range("A14") 'cell with first file name
    
    With objEmail
        .SentOnBehalfOfName = "company@company.com"
        .To = "company@company.com"
        .Subject = "Attached file(s)"
        .Body = "Have a nice day!"

        'check each file, and add if found
        Do While Len(cFile.Value) > 0
            fPath = FLDR & cFile.Value & ".pdf"
            If Len(Dir(fPath)) > 0 Then   'check if file exists
                .Attachments.Add fPath
            Else
                MsgBox "File not found" & vbLf & fPath, vbExclamation
            End If
            Set cFile = cFile.Offset(1) 'next file
        Loop
        .Display        ' Display the message in Outlook.
    End With
    
    Exit Sub
ErrHandler:
    Debug.Print Err.Description
    
End Sub
于 2021-07-02T18:25:20.787 回答