Multiple Attachments on single email from continuous subform (1 Viewer)

[allen675]

Hello once again,

I had previously posted with a very similar question but in that example I was using a list box. Having a re-think I was potentially adding an unnecessary step to my DB because I already have a list of the documents that are required to be attached in my 'ExisitngLeadF, as a continuous subform 'ContactProofF', to an email(please see attached screenshot).

I am slowly beginning to get the hang of VBA, however, I am nowhere near being competent enough to figure this one out for myself, so really looking for someone kind enough to do the groundwork on this one for me please. At a guess I somehow need to loop through the recordset and then do something(attach each file in continuous form to single email). The files are stored in a folder under the database and this folder is called 'ContactProofs'. Elsewhere in the DB I have used the application.currentproject path and would like to maintain this as unsure where end user will decide to keep their copy/version of DB.

Thanks in advance

 

[theDBguy]

What email client will you and your users be using?

 

[allen675]

Outlook

 

[theDBguy]

Outlook

Excellent. Have a look here.

VBA - Send Emails Using Outlook Automation | DEVelopers HUT

A sample reusable VBA function which employs MS Outlook automation to send e-mails. Easily implemented within an MS Access database...

www.devhut.net

 

[allen675]

@theDBguy how do I adapt that code to loop through the continuous subform?

 

[theDBguy]

@theDBguy how do I adapt that code to loop through the continuous subform?

You can collect all the paths into an array and pass it to the email function. It might actually be easier to grab the paths from the table than the subform, but either one should work.

When I get in front of a computer, I'll give you an example, if you need one.

Sent from phone...

 

[allen675]

An example would be very helpful please

 

[theDBguy]

An example would be very helpful please

Okay, that Outlook function can accept an Array as argument for the attachments. You can create an array in several ways. If we pull the paths from the table, one approach is to use the SimpleCSV() function from my website. Here's how I might do something like that:

Dim strPaths() As String
Dim strSQL As String

strSQL = "SELECT PathFieldName FROM TableName WHERE FKFieldName=" & Me.PKFieldName

strPaths = Split(SimpleCSV(strSQL),",")

You can then pass strPaths to the Email function.

I haven't tested any of that, so please let us know if you run into any issues. I am not sure if a Variant array argument would accept a String array input.

 

[allen675]

@theDBguy thank you for taking the time to do this but I haven't a clue where this piece of code should be going and what with. As I say in the original post really need help with the entire thing

 

[theDBguy]

@theDBguy thank you for taking the time to do this but I haven't a clue where this piece of code should be going and what with. As I say in the original post really need help with the entire thing

In that case, it might be easier if you could post a sample copy of your db with test data. Someone can then add the functionality for you, so you can test it.

 

[allen675]

Hi @theDBguy

So I've got this so far

strSQL = "SELECT [FileName] FROM ContactProofT" _
& " WHERE CustomerID = " & Forms!SubmitRefundF!CustomerID
strPaths = Split(SimpleCSV(strSQL), ",")

And trying to pass into outlook like so:

.Attachments.Add Application.CurrentProject.Path & "\ContactProofs\" & strPaths

But I am getting the following error message - Compile Error: Type mismatch and Debug highlights the & between "\ContactProofs\" and strPaths in the the above.

Ant ideas?

 

[theDBguy]

Hi @theDBguy

So I've got this so far

strSQL = "SELECT [FileName] FROM ContactProofT" _
& " WHERE CustomerID = " & Forms!SubmitRefundF!CustomerID
strPaths = Split(SimpleCSV(strSQL), ",")

And trying to pass into outlook like so:

.Attachments.Add Application.CurrentProject.Path & "\ContactProofs\" & strPaths

But I am getting the following error message - Compile Error: Type mismatch and Debug highlights the & between "\ContactProofs\" and strPaths in the the above.

Ant ideas?

Try adding this line before strPaths and let us know what it says in the Immediate Window.

Debug.Print strSQL

Also, how exactly did you declare the variable strPaths?

 

[allen675]

Tried that, nothing in the immediate window and brings me back to the same compile error type mismatch! :-(

 

[allen675]

Okay so was declaring strPaths as String now changed to Variant?, and getting this message in the Immediate window: SELECT [FileName] FROM ContactProofT WHERE CustomerID = 4

That is the correct CustomerID for this example.

Should I expect to see the file names rather than the above?

 

[theDBguy]

Okay so was declaring strPaths as String now changed to Variant?, and getting this message in the Immediate window: SELECT [FileName] FROM ContactProofT WHERE CustomerID = 4

That is the correct CustomerID for this example.

Should I expect to see the file names rather than the above?

No, you're seeing the correct thing. You can then try the following in the Immediate Window while in Debug mode and tell us what you get.

?SimpleCSV(strSQL)

 

[allen675]

Okay well at least that's something!

So done as above and now the compile error is ByRef argument type mismatch

 

[theDBguy]

Okay well at least that's something!

So done as above and now the compile error is ByRef argument type mismatch

Cool. Please repost the entire code as it stands right now, so we can check. Thanks.

 

[allen675]

Please dont judge me I'm not a coder!!!

Private Sub Command10_Click()

Dim appOutlook As Outlook.Application
Dim MailOutlook As Outlook.MailItem
Dim strSQL As String
Dim clientRST As Variant
Dim salesRST As Variant
Dim strTable As String
Dim i As Variant
Dim strPaths As Variant

    
strSQL = "SELECT [CustomerID], [Broker], [Lead_Date], [Client_FN], [Client_SN], [Email_Address], [Mobile_No], [Email_Sent], [SMS/WhatsApp_Sent], [Phone_Call_#1], [Phone_Call_#2], [Phone_Call_#3] FROM Client" _
& " WHERE CustomerID = " & Forms!SubmitRefundF!CustomerID
Set clientRST = CurrentDb.OpenRecordset(strSQL)

Do While Not clientRST.EOF
    Set appOutlook = CreateObject("Outlook.application")
    Set MailOutlook = appOutlook.CreateItemFromTemplate(Application.CurrentProject.Path & "\RefundRequest.oft")

    strSQL = "SELECT NoteDate, Note" _
              & " FROM NoteHistory" _
              & " WHERE CustomerID = " & clientRST!CustomerID
    Set salesRST = CurrentDb.OpenRecordset(strSQL)

    ' TABLE COLUMNS
    strTable = "<table><th>"
    For i = 0 To salesRST.Fields.Count - 1
        strTable = strTable & "<td>" & "</td>"
    Next i
    strTable = strTable & "</th>"

    ' TABLE ROWS
    salesRST.MoveFirst
    While Not salesRST.EOF
        strTable = strTable & "<tr>"
        For i = 1 To salesRST.Fields.Count
            strTable = strTable & "<td>" & salesRST.Fields(i - 1).Value & "</td>"
        Next i
        strTable = strTable & "</tr>"
        salesRST.MoveNext
    Wend
    strTable = strTable & "</table>"
    salesRST.Close
    
strSQL = "SELECT [FileName] FROM ContactProofT" _
& " WHERE CustomerID = " & Forms!SubmitRefundF!CustomerID
Debug.Print strSQL
strPaths = Split(SimpleCSV(strSQL), ",")


    With MailOutlook
        .To = "test@test.com"
        .subject = "Refund Request"
        .Attachments.Add CurrentProject.Path & "\ContactProofs\" & strPaths
        

        ' REPLACE PLACEHOLDERS
        .HTMLBody = Replace(.HTMLBody, "%date%", clientRST![Lead_Date])
        .HTMLBody = Replace(.HTMLBody, "%first%", clientRST![Client_FN])
        .HTMLBody = Replace(.HTMLBody, "%surname%", clientRST![Client_SN])
        .HTMLBody = Replace(.HTMLBody, "%mobile%", clientRST![Mobile_No])
        .HTMLBody = Replace(.HTMLBody, "%email%", clientRST![Email_Address])
        .HTMLBody = Replace(.HTMLBody, "%Call1%", clientRST![Phone_Call_#1])
        .HTMLBody = Replace(.HTMLBody, "%Call2%", clientRST![Phone_Call_#2])
        .HTMLBody = Replace(.HTMLBody, "%Call3%", clientRST![Phone_Call_#3])
        .HTMLBody = Replace(.HTMLBody, "%unsuccessful%", clientRST!Email_Sent)
        .HTMLBody = Replace(.HTMLBody, "%message%", clientRST![SMS/WhatsApp_Sent])
        .HTMLBody = Replace(.HTMLBody, "%Broker%", clientRST![Broker])
              

        ' ADD SALES TABLE
        .HTMLBody = Replace(.HTMLBody, "%Notes%", strTable)

        .Display
    End With

    Set MailOutlook = Nothing
    clientRST.MoveNext
Loop

End Sub

 

[theDBguy]

Please dont judge me I'm not a coder!!!

Private Sub Command10_Click()

Dim appOutlook As Outlook.Application
Dim MailOutlook As Outlook.MailItem
Dim strSQL As String
Dim clientRST As Variant
Dim salesRST As Variant
Dim strTable As String
Dim i As Variant
Dim strPaths As Variant

    
strSQL = "SELECT [CustomerID], [Broker], [Lead_Date], [Client_FN], [Client_SN], [Email_Address], [Mobile_No], [Email_Sent], [SMS/WhatsApp_Sent], [Phone_Call_#1], [Phone_Call_#2], [Phone_Call_#3] FROM Client" _
& " WHERE CustomerID = " & Forms!SubmitRefundF!CustomerID
Set clientRST = CurrentDb.OpenRecordset(strSQL)

Do While Not clientRST.EOF
    Set appOutlook = CreateObject("Outlook.application")
    Set MailOutlook = appOutlook.CreateItemFromTemplate(Application.CurrentProject.Path & "\RefundRequest.oft")

    strSQL = "SELECT NoteDate, Note" _
              & " FROM NoteHistory" _
              & " WHERE CustomerID = " & clientRST!CustomerID
    Set salesRST = CurrentDb.OpenRecordset(strSQL)

    ' TABLE COLUMNS
    strTable = "<table><th>"
    For i = 0 To salesRST.Fields.Count - 1
        strTable = strTable & "<td>" & "</td>"
    Next i
    strTable = strTable & "</th>"

    ' TABLE ROWS
    salesRST.MoveFirst
    While Not salesRST.EOF
        strTable = strTable & "<tr>"
        For i = 1 To salesRST.Fields.Count
            strTable = strTable & "<td>" & salesRST.Fields(i - 1).Value & "</td>"
        Next i
        strTable = strTable & "</tr>"
        salesRST.MoveNext
    Wend
    strTable = strTable & "</table>"
    salesRST.Close
    
strSQL = "SELECT [FileName] FROM ContactProofT" _
& " WHERE CustomerID = " & Forms!SubmitRefundF!CustomerID
Debug.Print strSQL
strPaths = Split(SimpleCSV(strSQL), ",")


    With MailOutlook
        .To = "test@test.com"
        .subject = "Refund Request"
        .Attachments.Add CurrentProject.Path & "\ContactProofs\" & strPaths
        

        ' REPLACE PLACEHOLDERS
        .HTMLBody = Replace(.HTMLBody, "%date%", clientRST![Lead_Date])
        .HTMLBody = Replace(.HTMLBody, "%first%", clientRST![Client_FN])
        .HTMLBody = Replace(.HTMLBody, "%surname%", clientRST![Client_SN])
        .HTMLBody = Replace(.HTMLBody, "%mobile%", clientRST![Mobile_No])
        .HTMLBody = Replace(.HTMLBody, "%email%", clientRST![Email_Address])
        .HTMLBody = Replace(.HTMLBody, "%Call1%", clientRST![Phone_Call_#1])
        .HTMLBody = Replace(.HTMLBody, "%Call2%", clientRST![Phone_Call_#2])
        .HTMLBody = Replace(.HTMLBody, "%Call3%", clientRST![Phone_Call_#3])
        .HTMLBody = Replace(.HTMLBody, "%unsuccessful%", clientRST!Email_Sent)
        .HTMLBody = Replace(.HTMLBody, "%message%", clientRST![SMS/WhatsApp_Sent])
        .HTMLBody = Replace(.HTMLBody, "%Broker%", clientRST![Broker])
              

        ' ADD SALES TABLE
        .HTMLBody = Replace(.HTMLBody, "%Notes%", strTable)

        .Display
    End With

    Set MailOutlook = Nothing
    clientRST.MoveNext
Loop

End Sub

You have this:

Dim strPaths As Variant

Try changing it to this instead:

Dim strPaths() As String

 

[theDBguy]

You have this:

Dim strPaths As Variant

Try changing it to this instead:

Dim strPaths() As String

Oh, and this:

.Attachments.Add CurrentProject.Path & "\ContactProofs\" & strPaths

needs to change into a loop. For example:

Dim x As Long
For x = 0 To Ubound(strPaths)
    .Attachments.Add strPath(x)
Next

Just to check, can you show us the result of the following in the Immediate Window?

?strPaths(0)