通过电子邮件发送来自一个表格路径的多个图像和一个报告.pdf。

Question

我有一个表(tbl_AccidentImages)，它只保存文件夹名称和图像名称以及AccidentID相关联。

然后我使用一个函数来获取图片文件夹的路径，使用。

Public Function GetCurrentPath() As String

'Gets path of current BE table. Move image folder in with BE

Dim strFullPath As String
strFullPath = Mid(DBEngine.Workspaces(0).Databases(0).TableDefs("tbl_AccidentImages").Connect, 11)
GetCurrentPath = Left(strFullPath, InStrRev(strFullPath, "\"))
End Function

好了，现在我试图让工作的代码是拼凑起来的 因为我真的找不到任何固体的东西。下面是代码，我不能让附件工作，它停止了一个。

.Attachments.Add (Attachments)

并给出错误信息

运行时错误'-2147024809 (80070057)' 。

出了点问题。我不知道也许有一个简单的方法，你们可以告诉我... ... 我迷路了，需要帮助 下面是我目前所拥有的。

    Public Sub SendOutlookEmail()

Dim myMail As Outlook.MailItem
Dim myOutlApp As Outlook.Application
Dim FilePathToAdd As String
Dim Attachments() As String
Dim i As Integer
Dim db As DAO.Database
Dim rs As DAO.Recordset

'Create an Outlook-Instance and a new Mailitem
Set myOutlApp = New Outlook.Application
Set myMail = myOutlApp.CreateItem(olMailItem)

    Set rs = fDAOGenericRst("SELECT tbl_AccidentImages.ImagePath " & _
                              "FROM tbl_AccidentImages " & _
                              "WHERE (((tbl_AccidentImages.AccidentID)=" & [Forms]![frm_AccidentIllnessEntry]![txtAccidentID] & "));")

    With rs
        If (Not .BOF) And (Not .EOF) Then
            .MoveFirst
            FilePathToAdd = GetCurrentPath() & .Fields("ImagePath")
            .MoveNext
        End If

        If (Not .BOF) And (Not .EOF) Then
            Do Until .EOF
 'Adds a ; between each path and takes away \ between the file path and the file
                FilePathToAdd = FilePathToAdd & "; " & Replace(GetCurrentPath() & .Fields("ImagePath"), "\\", "\")
                .MoveNext
            Loop
        End If

        .Close

    End With

    If FilePathToAdd <> "" Then
        Attachments = Split(FilePathToAdd, ";")
        For i = LBound(Attachments) To UBound(Attachments)
            If Attachments(i) <> "" Then
                myMail.Attachments.Add Trim(Attachments(i))
            End If
            Next i
        End If

    With myMail
    .To = "[email protected]"
    .Subject = "Subject Line"
    .Body = "This is the body"
    .Attachments.Add (Attachments)

'Send or Display email
        .Display
       '.Send
    End With

'Terminate the Outlook Application instance
    myOutlApp.Quit

'Destroy the object variables and free the memory
    Set myMail = Nothing
    Set myOutlApp = Nothing

End Sub

Answer 1

已经在数组循环中添加了附件。去掉这个二次添加行。不要去管数组，只需要在recordset循环中添加附件。

    With rs
        If (Not .BOF) And (Not .EOF) Then
            Do Until .EOF
                'takes away \ between the file path and the file
                MyMail.Attachments.Add Replace(GetCurrentPath() & .Fields("ImagePath"), "\\", "\")
                .MoveNext
            Loop
        End If
        .Close
    End With

    With myMail
    .To = "[email protected]"
    .Subject = "Subject Line"
    .Body = "This is the body"
    .Display
    End With

Answer 2

看起来你试图添加附件两次--一次应该就够了，因此代码可能会变成。

If FilePathToAdd <> "" Then
    With myMail
        .To = "[email protected]"
        .Subject = "Subject Line"
        .Body = "This is the body"
        With .Attachments
            Dim att
            For each att in Split(FilePathToAdd, ";")
                If att <> "" Then .Add Trim(att)
            Next att
        End With
        .Send
    End With
End If