Add Multiple Attachments To An Outlook Email (1 Viewer)

Dim olApp As Outlook.Application
Dim olMail As MailItem
Dim objOutlookAttach As Outlook.Attachment

Set olApp = New Outlook.Application
Set olMail = olApp.CreateItem(olMailItem)

With olMail
    .BodyFormat = olFormatHTML
    .To = Left(pubMessageRecipientsToAddress, Len(pubMessageRecipientsToAddress) - 1)
    .CC = ""
    .Subject = pubMessageSubject
    .Body = pubMessageBody
  
    'Add Attachments
    Dim db As DAO.Database
    Dim rstAttachements As DAO.Recordset
        
    Set db = CurrentDb()
    Set rstAttachments = db.OpenRecordset("Select EMailAttachment from tblTempSendEMailAttachments")
    
    If rstAttachments.RecordCount > 0 Then
        With rstAttachments
            .MoveLast
            .MoveFirst
                   
            Do Until .EOF
                If DoesFileExist(rstAttachments!EMailAttachment) Then
                    Set objOutlookAttach = .Attachments.Add(rstAttachments!EMailAttachment)
                End If
                .MoveNext
            Loop
        End With
    End If
    
    .Save
    .Send
End With

Set olMail = Nothing
Set objOutlookAttach = Nothing
Set olApp = Nothing

MsgBox "Mail Sent!", vbOKOnly, "Mail Sent"

Dim olApp As Outlook.Application
Dim olMail As Outlook.MailItem
Dim objOutlookAttach As Outlook.Attachment

Set olApp = New Outlook.Application
Set olMail = olApp.CreateItem(olMailItem)

With olMail
    .BodyFormat = olFormatHTML
    .To = Left(pubMessageRecipientsToAddress, Len(pubMessageRecipientsToAddress) - 1)
    .CC = ""
    .Subject = pubMessageSubject
    .Body = pubMessageBody

    'Add Attachments
    Dim db As DAO.Database
    Dim rstAttachments As DAO.Recordset
        
    Set db = CurrentDb()
    Set rstAttachments = db.OpenRecordset("Select EMailAttachment from tblTempSendEMailAttachments")
    
    If rstAttachments.RecordCount > 0 Then
        With rstAttachments
            Do Until .EOF
                If DoesFileExist(rstAttachments!EMailAttachment) Then
                    olMail.Attachments.Add (rstAttachments!EMailAttachment)
                End If
                .MoveNext
            Loop
        End With
    End If

    .Save
    .Send
End With

Set olMail = Nothing
Set objOutlookAttach = Nothing
Set olApp = Nothing
Set rstAttachments = Nothing
Set db = Nothing

MsgBox "Mail Sent!", vbOKOnly, "Mail Sent"

strSql = "SELECT TBL_DodacieListy.Faktura" & _
" FROM TBL_DodacieListy" & _
" WHERE TBL_DodacieListy.ID_kup = " & Forms!F_Faktura!Fkup.Value & " AND TBL_DodacieListy.FakturaOdoslana = TRUE" & _
" AND Day(TBL_DodacieListy.FakturaOdoslanaDna) = " & Forms!F_Faktura!Den.Value & " AND Month(TBL_DodacieListy.FakturaOdoslanaDna) = " & Forms!F_Faktura!Mesiac.Value & " AND Year(TBL_DodacieListy.FakturaOdoslanaDna) = " & Forms!F_Faktura!Rok.Value

strRST1 = strRST1 & Path & rstattach.Fields("[Faktura]")

Dim db As DAO.Database
Set db = CurrentDb
Dim rstattach As DAO.Recordset
Dim Path As String
Dim File As String
Path = "W:\POSTA\E_faktury\NA_ODOSLANIE\"
Set rstattach = db.OpenRecordset(strSql, dbOpenDynaset)


strSql = "SELECT TBL_DodacieListy.Faktura" & _
" FROM TBL_DodacieListy" & _
" WHERE TBL_DodacieListy.ID_kup = " & Forms!F_Faktura!Fkup.Value & " AND TBL_DodacieListy.FakturaOdoslana = TRUE" & _
" AND Day(TBL_DodacieListy.FakturaOdoslanaDna) = " & Forms!F_Faktura!Den.Value & " AND Month(TBL_DodacieListy.FakturaOdoslanaDna) = " & Forms!F_Faktura!Mesiac.Value & " AND Year(TBL_DodacieListy.FakturaOdoslanaDna) = " & Forms!F_Faktura!Rok.Value



Do While Not rstattach.EOF
strRST1 = Path & rstattach.Fields("[Faktura]")
rstattach.MoveNext
Loop
     
File = Dir(strRST1 & "*")

Debug.Print strSql
Debug.Print strRST1
Debug.Print File

 
   With olNewEmail   'Attach template
      .to = strContactEmail
  '    .CC = strCc
      .display
      .Subject = strEmailSubject
      
      .htmlbody = strEmailText & olNewEmail.htmlbody & strline
      
      .attachments.Add Path & File
            
   End With