Отправьте по электронной почте несколько изображений из пути к таблицам и один отчет в формате 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

Хорошо, теперь код Я пытаюсь собрать работу по кусочкам, потому что я действительно не могу найти ничего solid по этому поводу. Ниже приведен код, и я не могу заставить вложения работать вообще, и он останавливает:

.Attachments.Add (Attachments)

и выдает ошибку

Run-time error '-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 = "recipient@somewhere.com"
    .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

Уже добавлены вложения в массив l oop. Удалите эту вторичную строку добавления. Не беспокойтесь о массиве, просто добавьте вложения в набор записей l oop.

    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 = "recipient@somewhere.com"
    .Subject = "Subject Line"
    .Body = "This is the body"
    .Display
    End With

Answer 2

Похоже, вы пытаетесь добавить вложения дважды - одного раза должно быть достаточно, поэтому код может выглядеть следующим образом:

If FilePathToAdd <> "" Then
    With myMail
        .To = "recipient@somewhere.com"
        .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