将所选文件夹中的多个 PDF 附加到电子邮件

Question

我正在尝试允许用户select他们保存多个 PDF 的文件夹并提取它们。

除非我输入特定的路径名，否则我无法正确获取运行的宏。

这有效，如果我不引用函数而是引用特定路径名：

StrPath = "C:\Users\Mark\OneDrive - Corporation\Desktop\Work file\RemA\Canada\"

我的完整代码，没有附加任何 PDF：

Option Explicit

Private Function selectfolder()

'Defining the Variables
Dim user_name As String 'sequence of characters: alphabets, numbers, special characters
user_name = Environ("username") 'to pick up the username from work environment

'Prompt for folder creation
With Application.FileDialog(msoFileDialogFolderPicker) 'standard wording
    .Title = "Select the folder to save"
    .InitialFileName = "C:\Users\" & user_name & "\OneDrive - Corporation\Desktop\Work file" 'base directory to open
    .AllowMultiSelect = False
    If .Show <> -1 Then Exit Function 'if user does not press OK, end the function'
    selectfolder = .SelectedItems(1)
End With

End Function

Sub sendremindermail()

'Defining the Variables
Dim outlookapp As Object
Dim outlookmailitem As Object
Dim myattachments As Object
Dim StrPath As String
Dim StrFile As String
Dim network, Fldr As String

'If user does not choose a folder
StrPath = selectfolder()
If StrPath = "" Then
    Exit Sub
End If

Set outlookapp = CreateObject("outlook.application")
Set outlookmailitem = outlookapp.createitem(0)
Set myattachments = outlookmailitem.Attachments

'Creating the email and adding attachment
With outlookmailitem
    'Title of the Email
    .Subject = "Test Run"
    'To be sent to recipients
    .To = "ABCD@gmail.com"
    'Body of the email
    .Body = "Dear " & ActiveSheet.Range("C6").Value & ","
    .Body = .Body & "Please find attached your Finance Report for the month of " & Format(Range("C8"), "mmmm yyyy") & "."

    'Attach your files
    StrFile = Dir(StrPath & "*.pdf")
    Do While Len(StrFile) > 0
        myattachments.Add StrPath & StrFile
        StrFile = Dir
    Loop
   
    'Displaying only the email. Not sending
    .Display
End With

End Sub

Answer 1

函数selectfolder return路径末尾没有''，所以请在末尾加上''，所以selectfolder必须return像"c:\temp\pdffolder'，目前正在 returning 'c:\temp\pdffolder'，因此 Dir 行未 returning 文件。

将所选文件夹中的多个 PDF 附加到电子邮件

Attaching multiple PDFs from selected folder to email

excel

outlook

vba