Generate and send by email individual reports based on a query

[joaolabisa]

Hello to All,

I am trying to make an automation in order generate reports based on query ( person name,person email address ) , export them to a folder in PDF and then send them one by one to each person email address.
Please find my code below.

What is happening:
- the reports are generated and exported fine
- the email are sent to the right addresses but the first person receives the correct report , the second person receives the report from the first person plus its own report and so on...

I think some is wrong my structure , I am a VBA beginner ...

Help will be much appreciated !

Best Regards,

Here is my code :



Private Sub MakeReportSendEmail_Click()


Dim MyDB As DAO.Database
Dim MyRS As DAO.Recordset
Dim strSQL As String
Dim strRptName As String
Dim count As Integer
Dim strFilter As String


Dim imsg As Object
Dim iconf As Object
Dim flds As Object
Dim schema As String

Dim strPath As String
Dim strFilterEmail As String
Dim strFile As String


strRptName = "MyReportName"
strSQL = "SELECT * FROM MyQueryNameEmail ORDER BY Name"


Set MyDB = CurrentDb
Set MyRS = MyDB.OpenRecordset(strSQL, dbOpenForwardOnly)


Set imsg = CreateObject("CDO.Message")
Set iconf = CreateObject("CDO.Configuration")
Set flds = iconf.Fields

schema = "http://schemas.microsoft.com/cdo/configuration/"


flds.Item(schema & "sendusing") = 2
flds.Item(schema & "smtpserver") = "smtp.gmail.com"
flds.Item(schema & "smtpserverport") = 25
flds.Item(schema & "smtpauthenticate") = 1
flds.Item(schema & "smtpusessl") = True
flds.Item(schema & "smtpconnectiontimeout") = 60
flds.Item(schema & "sendusername") = "xxxx"
flds.Item(schema & "sendpassword") = "xxxx"
flds.Update

With MyRS


Do While Not MyRS.EOF
DoCmd.OpenReport strRptName, acViewPreview, , "[TableWithNames].Name='" & ![Name] & "'"
DoCmd.OutputTo acOutputReport, strDocName, acFormatPDF, "C:\Pdfs\" & ![Name] & ".pdf"
DoCmd.Close acReport, strRptName, acSaveNo

strPath = "C:\Pdfs\"
strFilterEmail = "*.pdf"
strFile = Dir(strPath & strFilterEmail)


With imsg
.to = MyRS.Fields("Email")
.From = "some_email@gmail.com"
.Subject = "Test Subject:"
.HTMLBody = "Test Body"
.AddAttachment strPath & strFile
Set .Configuration = iconf
.Send
End With


.MoveNext
Loop
End With
MyRS.Close
Set MyRS = Nothing
End Sub

[ItsMe]

The problem seems to be with the following.

strPath = "C:\Pdfs\"
strFilterEmail = "*.pdf"
strFile = Dir(strPath & strFilterEmail)

You are having CDO go after a wildcard in the PDF folder. So you are emailing a random file as you loop through the table with email addresses.

You need to use your string variables for both the CDO email and the Docmd that generates the report. Initialize the variables FIRST. Then use the variables in your OutputTO

Do While Not MyRS.EOF

strPath = "C:\Pdfs\"
strFile = ![Name] & ".pdf"

DoCmd.OpenReport strRptName, acViewPreview, , "[TableWithNames].Name='" & ![Name] & "'"
DoCmd.OutputTo acOutputReport, strDocName, acFormatPDF, strPath & strFile
DoCmd.Close acReport, strRptName, acSaveNo

If you notice, I did not use the Dir() function. All you need to do is create a string using the current DAO record and concatenate the static path to the dynamic file name.

Your CDO is already concatenating strPath and strFile. Should not be a need to make adjustments. The following looks good

.AddAttachment strPath & strFile



.

[joaolabisa]

Hi , Thanks!

I was doing the modifications that you suggested and after this the attachments keep the same behavior.
Everything keeps working fine.
On the other post i have translated some parts from to English , here his the exact code after the changes just to be on the safe side.

Private Sub Command55_Click()

Dim MyDB As DAO.Database
Dim MyRS As DAO.Recordset
Dim strSQL As String
Dim strRptName As String
Dim count As Integer
Dim imsg As Object
Dim iconf As Object
Dim flds As Object
Dim schema As String

strRptName = "Exporta_Listagem de Processos por técnico - Detalhe"
strSQL = "Select * FROM Qry_Processos_Fechados_por_tecnico_ano_2014_lista_ unica ORDER BY Nome"


Set MyDB = CurrentDb
Set MyRS = MyDB.OpenRecordset(strSQL, dbOpenForwardOnly)
Set imsg = CreateObject("CDO.Message")
Set iconf = CreateObject("CDO.Configuration")
Set flds = iconf.Fields


schema = "http://schemas.microsoft.com/cdo/configuration/"
flds.Item(schema & "sendusing") = 2
flds.Item(schema & "smtpserver") = "smtp.gmail.com"
flds.Item(schema & "smtpserverport") = 25
flds.Item(schema & "smtpauthenticate") = 1
flds.Item(schema & "smtpusessl") = True
flds.Item(schema & "smtpconnectiontimeout") = 60
flds.Item(schema & "sendusername") = "xxx"
flds.Item(schema & "sendpassword") = "xxx"
flds.Update

With MyRS


Do While Not MyRS.EOF


strPath = "\\FET\Departamento Tecnico e Aplicações\DocsExportadosGestaoGlobal\ras\"
strFile = ![Nome] & ".pdf"


DoCmd.OpenReport strRptName, acViewPreview, , "[1_Tecnicos Master].Nome='" & ![Nome] & "'"
DoCmd.OutputTo acOutputReport, strRptName, acFormatPDF, strPath & strFile
DoCmd.Close acReport, strRptName, acSaveNo


With imsg
.to = MyRS.Fields("Email")
.From = "bbb@ccc"
.Subject = "Test Subject:"
.HTMLBody = "Test Body"
.AddAttachment strPath & strFile
Set .Configuration = iconf
.Send
End With


.MoveNext
Loop
End With
MyRS.Close
Set MyRS = Nothing
End Sub

[ItsMe]

Before you run your code, delete all of the PDF files in the ras folder. After you delete the files, run another test and see if it works. I don't see any issue with your code. I may change a couple of small things but, when I read the code, I do not see a problem with it.

When I export reports to a temp folder for emailing, I run some code to go through and delete the temp files first. I use this code to delete the files in the directory BEFORE ANY exporting or emailing. Doing it before ensures me that the program is not using any of the PDF files.

'Delete the PDF files in the temp folder
Dim strFile As String
    strFile = "C:\Test"
Dim fsoFile As New FileSystemObject
Dim objFolder As Folder
Dim objFile As File
    Set objFolder = fsoFile.GetFolder(strFile)
    
        For Each objFile In objFolder.Files
        
            If InStr(objFile.Name, ".PDF") Then    'Select all file names that contain the text .PDF
                objFile.Delete True
            End If
        
        Next
    
    Set objFolder = Nothing
'end 'Delete the PDF files in the temp folder

[joaolabisa]

i try to delete the files first , same result.

any way to delete the files each time they are created and sent by email ? keep only the file on the folder while is needed to send by email.

[joaolabisa]

i found the solution!

Move the Set imsg = CreateObject("CDO.Message")
to inside the loop !

[ItsMe]

Interresting.

You are also going to want to release the object from the form's memory before it loops to the next record. For good measure, initialize to = Nothing. So, before the line, "Loop"....

Loop
Set imsg = Nothing
End With

Post if you have any more issues and glad you were able to spot that. I was thinking I would have to start testing and or look at some of my working examples to see what was wrong.