Question

我尝试将电子邮件发送到地址列表，并将整个pdf添加到文件夹中，

代码解决了我的问题是只有在我填写完整路径时才可以添加文件。

我希望它转到D并从文件夹中获取所有pdf或文件并创建电子邮件。

所以一切都有效，除了附件需要一个完整的路径，但我只是想放置文件夹的路径，它将从中获取所有文件，谢谢。

Sub massemailsend()

    Dim objOutlook As Object
    Dim objMail As Object
    Dim ws As Worksheet



    Set objOutlook = CreateObject("Outlook.Application")
    Set ws = ActiveSheet


  For Each cell In ws.Range("A1:A70")


    Set objMail = objOutlook.CreateItem(0)


        With objMail
            .To = cell.Value
            .Subject = cell.Offset(0, 1).Value
            .Body = cell.Offset(0, 2).Value
            '\\Attacment from here
            .Attachments.Add cell.Offset(0, 3).Value
            .Display
        End With


        Set objMail = Nothing
    Next cell


    Set ws = Nothing
    Set objOutlook = Nothing


End Sub

Answer 1

我总是使用此函数，返回与您的规范匹配的所有文件名的数组。您可以超级轻松地将其集成到您的代码中。

Function GetFileList(FileSpec As String) As Variant
'   Returns an array of filenames that match FileSpec
'   If no matching files are found, it returns False

    Dim FileArray() As Variant
    Dim FileCount As Integer
    Dim FileName As String

    On Error GoTo NoFilesFound

    FileCount = 0
    FileName = Dir(FileSpec)
    If FileName = "" Then GoTo NoFilesFound

    'Loop until no more matching files are found
    Do While FileName <> ""
        FileCount = FileCount + 1
        ReDim Preserve FileArray(1 To FileCount)
        FileArray(FileCount) = FileName
        FileName = Dir()
    Loop
    GetFileList = FileArray
    Exit Function

    '   Error handler
NoFilesFound:
    GetFileList = False
End Function

功能来自http://spreadsheetpage.com/index.php/tip/getting_a_list_of_file_names_using_vba/

Answer 2

如果路径始终相同，请在此处将其定义在顶部（包括尾部反斜杠）

Const myPath = "D:\FilesAreHere\"

然后将附件行更改为：

.Attachments.Add myPath & cell.Offset(0, 3).Value

VBA将文件夹中的所有文件添加到电子邮件中

2 个答案: