Help me understand my Loop Problems (1 Viewer)

[Therefore]

Hello all,
I have used a lot of code from various posts on here and it has been very helpful and has got me 99% of the way where I want to be. My script does the following:

1. Sets Variables and directories.
2. Creates folders
3. Creates a PDF from the current form
4. Saves attachments to a folder

If there are multiple records in the table, the PDF step saves all of the records one after another in one PDF. I would like for the PDF function to only write the current record as the PDF, but still save all of the attachments contained in that single record.

I'm sure it has something to do with the loop I found, but I can't seem to come up with a way to make sure the only content the PDF creates is in the current record.

The following is the code.

Private Sub Save_Gaurdrail_Hit_Click()
Dim MyFilter As String
Dim MyPath As String
Dim MyFilename As String
Dim oFSO
Set oFSO = CreateObject("Scripting.FileSystemObject")
oFSO.CreateFolder "T:\Trinity Guardrail\" + Me.Major_Route & Space(1) + Me.Maintenance_Jurisdiction & " - MM " + Me.County___State_Milepoint
MyFilename = Me.Major_Route & Space(1) + Me.Maintenance_Jurisdiction & " - " + Me.County___State_Milepoint
MyPath = "T:\Trinity Guardrail\" + Me.Major_Route & Space(1) + Me.Maintenance_Jurisdiction & " - MM " + Me.County___State_Milepoint

'Creates Attachements Folder'
Set oFSO = CreateObject("Scripting.FileSystemObject")
oFSO.CreateFolder MyPath + "\" + "Attachments"

'Creates PDF of form'
DoCmd.OutputTo acOutputForm, "Guardrail Hit", acFormatPDF, MyPath + "\" + MyFilename + ".pdf", False, , , acExportQualityScreen
Application.FollowHyperlink MyPath

' Exports all attachments in Guardrail Hit
On Error GoTo Err_SaveImage

Dim db As DAO.Database
Dim rsParent As DAO.Recordset2
Dim rsChild As DAO.Recordset2

Set db = CurrentDb
Set rsParent = Me.Recordset

rsParent.OpenRecordset

Set rsChild = rsParent.Fields("Attachments").Value

    With rsChild
    Do Until .EOF
    .MoveFirst
    
    rsChild.OpenRecordset
    rsChild.Fields("FileData").SaveToFile (MyPath + "\" + "Attachments")
    
    rsChild.Delete
    Me.Refresh
    
    .MoveNext
    
    Loop
    .Close
    MsgBox "Complete"
    End With

Exit_SaveImage:
Set rsChild = Nothing
Set rsParent = Nothing
Exit Sub

Err_SaveImage:
If Err = 3839 Then
    MsgBox ("File Already Exists in the Directory!")
    Resume Next
Else
    MsgBox "Some Other Error occured!", Err.Number, Err.Description
    Resume Exit_SaveImage
End If

End Sub

Help with this would be extremely appreciated as I have spent 4+ hours trying to figure this one out. I will answer any questions you have to help solve the problem.

 

[pbaldy]

There are several problems. To get individual PDF's, you'd have to create the PDF inside the loop, using the current value from the loop as a filter. That can be this method:

http://www.granite.ab.ca/access/email/reporttomultiplerecipients.htm

Or you can open the report in preview mode filtered:

http://www.baldyweb.com/wherecondition.htm

then output it, then close it. Not sure what you're doing with the child recordset, though it looks like it deals with an attachment field, which I've never used (I save paths).