Solved Attaching multi images and a pdf to outlook (1 Viewer)

oxicottin

Learning by pecking away....
Local time
Today, 18:46
Joined
Jun 26, 2007
Messages
851
Hello, I already can get the pdf as a report but cant seem to attach multi images if there is any. The way im doing it now is DoCmd.SendObject acReport which I cant find anything on the web about multi attachments. I did however find using outlook and creating a collection and it works running a test in my DB except I have two issues.

1. The WHERE of my statement is creating a Run-time error '3061' Too few parameters Expected 1. But if I get rid of the WHERE it runs fine.
2. I have a table that saves the folder and file name then I use a function GetCurrentPath() to get the path of where the folder and files are. The below part of the code gathers the full path of each image separated by a ; and in a long row which debug.print shows.

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




            If (Not .BOF) And (Not .EOF) Then
Do Until .EOF
sImageList = sImageList & "; " & GetCurrentPath() & .Fields("ImagePath")
.MoveNext
Loop
            End If

            .Close

        End With

Now the original code found showed I had to use .add for each path which that way does work like show in the code.

'colFiles.Add "C:\Users\Bla\Desktop\Accident & Safety Database 6-15-20\\Images\31.jpg"
'colFiles.Add "C:\Users\Bla\Desktop\Accident & Safety Database 6-15-20\\Images\34.jpg"
'colFiles.Add "C:\Users\Bla\Desktop\Accident & Safety Database 6-15-20\\Images\35.jpg"

BUT instead im trying to loop through and create a list that can be added using colFiles.Add sImageList as shown in the full code but that isn't working. How can I loop through and colFiles.Add like it does when individually?

Code:
Public Sub testEmail()
Dim vTo, vSubj, vBody
Dim colFiles As New Collection
Dim db As DAO.Database
Dim rs As DAO.Recordset
Dim sImageList As String

vTo = "MrWiley.com"
vSubj = "test multi attachs"
vBody = "Dear Wiley"

 Set db = CurrentDb()
Set rs = db.OpenRecordset("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
sImageList = GetCurrentPath() & .Fields("ImagePath")
.MoveNext
            End If

            If (Not .BOF) And (Not .EOF) Then
Do Until .EOF
sImageList = sImageList & "; " & GetCurrentPath() & .Fields("ImagePath")
.MoveNext
Loop
            End If

            .Close

        End With
 [/code      

colFiles.Add sImageList

'colFiles.Add "C:\Users\Bla\Desktop\Accident & Safety Database 6-15-20\\Accident_Images\31.jpg"
'colFiles.Add "C:\Users\Bla\Desktop\Accident & Safety Database 6-15-20\\Accident_Images\34.jpg"
'colFiles.Add "C:\Users\Bla\Desktop\Accident & Safety Database 6-15-20\\Accident_Images\35.jpg"

Call Send1Email(vTo, vSubj, vBody, colFiles)

Set colFiles = Nothing

End Sub

Public Function Send1Email(ByVal pvTo, ByVal pvSubj, ByVal pvBody, Optional pcolFiles As Collection) As Boolean
Dim oApp As Outlook.Application
Dim oMail As Outlook.MailItem
Dim vFile As Variant

Set oApp = CreateObject("Outlook.Application")
Set oMail = oApp.CreateItem(olMailItem)

With oMail
.To = pvTo
.Subject = pvSubj
    .Body = pvBody

    If Not IsEmpty(pcolFiles) Then
For Each vFile In pcolFiles
Debug.Print vFile
Stop
.Attachments.Add vFile, olByValue, 1
Next
End If

.Send
End With
Send1Email = True

Set oMail = Nothing
Set oApp = Nothing
End Function
 

oxicottin

Learning by pecking away....
Local time
Today, 18:46
Joined
Jun 26, 2007
Messages
851
Thanks theDBguy but after looking at the link im not sure what to even do with the code. It says It automatically evaluates any parameters in your SQL but like I said what do I do?

I cant understand why im even getting the error because the query I created it with gives results just fine.
 

theDBguy

I’m here to help
Staff member
Local time
Today, 15:46
Joined
Oct 29, 2018
Messages
21,358
Thanks theDBguy but after looking at the link im not sure what to even do with the code. It says It automatically evaluates any parameters in your SQL but like I said what do I do?

I cant understand why im even getting the error because the query I created it with gives results just fine.
Hi. You could try using it this way. Copy and paste the DAO function into your project and then replace this line:

...
Set rs = db.OpenRecordset("SELECT tbl_AccidentImages.ImagePath " & _
...


With this one:

...
Set rs = fDAOGenericRst("SELECT tbl_AccidentImages.ImagePath " & _
...
 

oxicottin

Learning by pecking away....
Local time
Today, 18:46
Joined
Jun 26, 2007
Messages
851
theDBguy, I have no clue why but I don't get the error anymore, thanks!

Next, how do I add multiple images?
 
Last edited:

arnelgp

..forever waiting... waiting for jellybean!
Local time
Tomorrow, 06:46
Joined
May 7, 2009
Messages
19,169
can you show the GetCurrentPath() function.
 

oxicottin

Learning by pecking away....
Local time
Today, 18:46
Joined
Jun 26, 2007
Messages
851
can you show the GetCurrentPath() function.

Sure... it just gives me the beginning of the path to my image folder.

Code:
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
 

oxicottin

Learning by pecking away....
Local time
Today, 18:46
Joined
Jun 26, 2007
Messages
851
What about the code I pieced together would something like this work?

Code:
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 db = CurrentDb()
        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
                    FilePathToAdd = FilePathToAdd & "; " & 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 (FilePathToAdd)
            
'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
 
Last edited:

arnelgp

..forever waiting... waiting for jellybean!
Local time
Tomorrow, 06:46
Joined
May 7, 2009
Messages
19,169
change this one:

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

to:

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



view ImagePath field, does it already have the path + filename?
if it does remove GetCurrentPath() from the code, eg:

instead of:

FilePathToAdd = FilePathToAdd & "; " & GetCurrentPath() & .Fields("ImagePath")

change to:

FilePathToAdd = FilePathToAdd & "; " & .Fields("ImagePath")
 

oxicottin

Learning by pecking away....
Local time
Today, 18:46
Joined
Jun 26, 2007
Messages
851
arnelgp, the images table has the folder and image incase I move things around that's why Im using GetCurrentPath()
 

Attachments

  • test.JPG
    test.JPG
    18.9 KB · Views: 544

arnelgp

..forever waiting... waiting for jellybean!
Local time
Tomorrow, 06:46
Joined
May 7, 2009
Messages
19,169
i see, so you need to remove extra "\" when you do the concatenation:

FilePathToAdd = FilePathToAdd & "; " & Replace(GetCurrentPath() & .Fields("ImagePath"), "\\", "\")
 

oxicottin

Learning by pecking away....
Local time
Today, 18:46
Joined
Jun 26, 2007
Messages
851
Tank you all!

Code:
Public Sub SendOutlookEmail()
    
    Dim myMail As Outlook.MailItem
    Dim myOutlApp As Outlook.Application
    Dim FilePathToAdd As String
    Dim db As DAO.Database
    Dim rs As DAO.Recordset
    Dim att As Variant
    
'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
            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
        
'Terminate the Outlook Application instance
        myOutlApp.Quit
        
'Destroy the object variables and free the memory
        Set myMail = Nothing
        Set myOutlApp = Nothing
        
    End Sub
 

theDBguy

I’m here to help
Staff member
Local time
Today, 15:46
Joined
Oct 29, 2018
Messages
21,358
Tank you all!

Code:
Public Sub SendOutlookEmail()
   
    Dim myMail As Outlook.MailItem
    Dim myOutlApp As Outlook.Application
    Dim FilePathToAdd As String
    Dim db As DAO.Database
    Dim rs As DAO.Recordset
    Dim att As Variant
   
'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
            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
       
'Terminate the Outlook Application instance
        myOutlApp.Quit
       
'Destroy the object variables and free the memory
        Set myMail = Nothing
        Set myOutlApp = Nothing
       
    End Sub
Hi. Good luck with your project.
 

oxicottin

Learning by pecking away....
Local time
Today, 18:46
Joined
Jun 26, 2007
Messages
851
Just a few things I added that I need and wanted to upload so someone else can benefit. I added renaming and saving a .pdf of the report and then attaching it to the email and once attached delete the .pdf. I also added the ability to use a "email to" list loop.

Thanks Again and if you think something needs fixed or cleaned up please let me know. Thanks!

Code:
Public Sub SendOutlookEmail()
    Dim stClassification, stAccidentNum, stCreatedBy, stSubject, stBody, _
    sEmailList, FilePathToAdd, sExistingReportName, sAttachmentName, dbPath, relativePath As String
    Dim att As Variant
    Dim myMail As Outlook.MailItem
    Dim myOutlApp As Outlook.Application
    Dim db As DAO.Database
    Dim rs As DAO.Recordset
    
'----------------------------------------------------------Start of save & rename.pdf
'Input variables
    sExistingReportName = "rpt_AccidentIllnessEntry"    'Name of the Access report Object to send
    sAttachmentName = Me.txtAccidentID & "-" & Me.txtClassification     'Name to be used for the .pdf attachment in the e-mail
    
'By changing the report caption you effectively change the name used for the .pdf attachment in the .OutputTo method
    DoCmd.OpenReport sExistingReportName, acViewPreview, , "[AccidentID]=" & Me![txtAccidentID], acHidden
    Reports(sExistingReportName).Caption = sAttachmentName
    
'Setup new file name and appropriate DB subfolder
    relativePath = "\Accident_Images\" & sAttachmentName & ".pdf"
    
'Full path to .pdf
    dbPath = GetCurrentPath() & relativePath
    
'Output the .pdf file
    DoCmd.OutputTo acReport, sExistingReportName, acFormatPDF, dbPath, False
    
'Close hidden open .pdf(s) report
    DoCmd.Close acReport, sExistingReportName
'----------------------------------------------------------End of save & rename.pdf

'Create an Outlook-Instance and a new Mailitem
    Set myOutlApp = New Outlook.Application
    Set myMail = myOutlApp.CreateItem(olMailItem)
    
    stClassification = Me.txtClassification
    stAccidentNum = Me.txtAccidentID
    stCreatedBy = fOSUserName()
    
    stSubject = ":: New/Revised " & stClassification & " ::"
    stBody = "A new or revised " & stClassification & " has been created or edited." & Chr$(13) & _
    "Please review the .pdf document with your team members." & Chr$(13) & Chr$(13) & _
    "Classification:  " & stClassification & Chr$(13) & Chr$(13) & _
    "Accident Number:  " & stAccidentNum & Chr$(13) & Chr$(13) & _
    "Edited or Created By: " & stCreatedBy
    
'Loop through images associated with AccidentID
    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
            Do Until .EOF
               'Removes \ between the file path and the file
                myMail.Attachments.Add Replace(GetCurrentPath() & .Fields("ImagePath"), "\\", "\")
                .MoveNext
            Loop
        End If
        .Close
    End With
    
'Loop through emails in tbl_LoginUser to attach as sEmailList
    Set db = CurrentDb()
    Set rs = db.OpenRecordset("SELECT tbl_LoginUser.strSecurityEmail, tbl_LoginUser.UserSecurityType " & vbCrLf & _
    "FROM tbl_LoginUser " & vbCrLf & _
    "WHERE (((tbl_LoginUser.IsOnEmailList)=True));") 'Email only needed employees from tbl_LoginUser
    With rs
        If (Not .BOF) And (Not .EOF) Then
            Do Until .EOF
                sEmailList = sEmailList & "; " & .Fields("strSecurityEmail")
                .MoveNext
            Loop
        End If
        .Close
    End With
    
    With myMail
        .To = sEmailList
        .Subject = stSubject
        .Body = stBody
        .Attachments.Add dbPath
        .Display 'Display the email
       '.Send 'Send the email without prompts
    End With
    
'Delete the .pdf saved in the DB subfolder
    Kill (dbPath)
    
'Set object variables to nothing and free the memory
    Set myMail = Nothing
    Set myOutlApp = Nothing
    db.Close
    Set rs = Nothing
    Set db = Nothing
    
End Sub
 

Users who are viewing this thread

Top Bottom