Solved loop thru continuous form and add attachments to outlook message

[laffeg]

hi

trying to get an email in outlook with as many PDF attachments as there are records in the continuous subform -ie 1 attachment per subform record

in code below ( which is button on the subform ) 4 possible values for Me![Master] hence the if then statements - it should determine which report generates the PDF for the current record in subform

in my test record there are 2 entries in the continuous sub form
it's looping ok but result is the first record attached twice - what am i missing with the looping ?
my vb skills are fairly limited hope i've explained it simply
thanks

Dim oApp As Object
    Dim oEmail As Object
    Dim FSO As New FileSystemObject
    Dim folderPath As String
    Dim fileName As String
    
    '* begin - agp
    Dim rs As DAO.Recordset
    Set rs = Me.RecordsetClone
    Set rs = rs.OpenRecordset
    '* end - agp
    
    Set oApp = CreateObject("Outlook.Application")
    Set oEmail = oApp.CreateItem(0)
    
        
    oEmail.To = ""
    oEmail.Subject = "Please find attached your certificates"
    oEmail.Body = "Hi  your certificates are attached in PDF format"
    
    With rs
        If Not (.BOF And .EOF) Then .MoveFirst
        While Not .EOF
        
        If Me![Master] = "DOUBLE" Then
        DoCmd.OutputTo acOutputReport, "rptdoublecert2", acFormatPDF, "c:\dbase\" & Me![CERT_NUM] & ".pdf", False
        oEmail.Attachments.Add "c:\dbase\" & Me![CERT_NUM] & ".pdf"
        Else
        End If
        
           If Me![Master] = "SINGLE" Then
            DoCmd.OutputTo acOutputReport, "rptsingle2", acFormatPDF, "c:\dbase\" & Me![CERT_NUM] & ".pdf", False
            oEmail.Attachments.Add "c:\dbase\" & Me![CERT_NUM] & ".pdf"
            Else
            End If
    
            If Me![Master] = "BLANK" Then
            DoCmd.OutputTo acOutputReport, "rptblank", acFormatPDF, "c:\dbase\" & Me![CERT_NUM] & ".pdf", False
            oEmail.Attachments.Add "c:\dbase\" & Me![CERT_NUM] & ".pdf"
            Else
            End If
        
            If Me![Master] = "TREBLE" Then
            DoCmd.OutputTo acOutputReport, "rpttreble2", acFormatPDF, "c:\dbase\" & Me![CERT_NUM] & ".pdf", False
            oEmail.Attachments.Add "c:\dbase\" & Me![CERT_NUM] & ".pdf"
            Else
            End If
              
        .MoveNext
        Wend
    End With
    Set rs = Nothing
  oEmail.Display

 

[Uncle Gizmo]

what am i missing

Your post is missing the code formatting option which makes it much easier for everyone to read!

Surround your code with

'[Code]   code here [Code/] 

[Code/]

 

[laffeg]

hi
anyone able to help ?
thanks

 

[bastanu]

Replace Me![CERT_NUM] with rs![CERT_NUM].
(and Me![Master] with rs![Master])
Cheers,

 

[laffeg]

so with rs instead of me I get attachments with the right certificate numbers as the filenames, however the 2nd attachment is just the first PDF duplicated - if that makes sense

 

[bastanu]

It kinda' does because your report probably makes reference to the first unique ID. What you want to do is to add these lines to a standard module:

Public lngUniqueID as Long
Public Function fnUniqueIDForReport() as Long
fnUniqueIDForReport=lngUniqueID
End Function

Now at the start of your loop (after the While...EOF) add lngUniqueID =rs![YourUniqueIDUsedBYReport] and finally change the four reports to replace the reference to the subform control for the ID to fnUniqueIDForReport().

Cheers,

 

[arnelgp]

    Dim oApp As Object
    Dim oEmail As Object
    Dim FSO As New FileSystemObject
    Dim folderPath As String
    Dim fileName As String
    
    '* begin - agp
    Dim colCert As New Collection
    Dim rs As DAO.Recordset
    Set rs = Me.RecordsetClone
    Set rs = rs.OpenRecordset
    '* end - agp
    
    Set oApp = CreateObject("Outlook.Application")
    Set oEmail = oApp.CreateItem(0)
    
        
    oEmail.To = ""
    oEmail.Subject = "Please find attached your certificates"
    oEmail.Body = "Hi  your certificates are attached in PDF format"
    
    With rs
        If Not (.BOF And .EOF) Then .MoveFirst
        
        While Not .EOF
            
            
            On Error Resume Next
            If Nz(![CERT_NUM], "@!") <> "@!" Then
                Err.Clear
                colCert.Add ![CERT_NUM], ![CERT_NUM] & ""
                If Not Err Then
                    If ![Master] = "DOUBLE" Then
                    DoCmd.OutputTo acOutputReport, "rptdoublecert2", acFormatPDF, "c:\dbase\" & ![CERT_NUM] & ".pdf", False
                    oEmail.Attachments.Add "c:\dbase\" & ![CERT_NUM] & ".pdf"
                    End If
                    
                       If ![Master] = "SINGLE" Then
                        DoCmd.OutputTo acOutputReport, "rptsingle2", acFormatPDF, "c:\dbase\" & ![CERT_NUM] & ".pdf", False
                        oEmail.Attachments.Add "c:\dbase\" & ![CERT_NUM] & ".pdf"
                        End If
                
                        If ![Master] = "BLANK" Then
                        DoCmd.OutputTo acOutputReport, "rptblank", acFormatPDF, "c:\dbase\" & ![CERT_NUM] & ".pdf", False
                        oEmail.Attachments.Add "c:\dbase\" & ![CERT_NUM] & ".pdf"
                        End If
                    
                        If ![Master] = "TREBLE" Then
                        DoCmd.OutputTo acOutputReport, "rpttreble2", acFormatPDF, "c:\dbase\" & ![CERT_NUM] & ".pdf", False
                        oEmail.Attachments.Add "c:\dbase\" & ![CERT_NUM] & ".pdf"
                        End If
                    End If
            End If
            .MoveNext
        Wend
    End With
    Set rs = Nothing
    Set colCert = Nothing
  oEmail.Display

 

[laffeg]

many thanks bastanu - that is now working the way i want it to - much kudos

 

[bastanu]

You're very welcome!