Correctly attaching a Zip file using VBA to Email

Hello Experts,
I have MS Access VBA that extracts Access reports, combines them into a zip file and attaches them into an email message but the attached zip file at times doesn’t contain both reports.  For example the zip file residing on our network does have both reports but the attached email zip file doesn’t have both reports.  Is there VBA to prevent this scenario or is it a possible network problem?  Perhaps, I create the zip file on my hard drive, attach it to email then copy the zip file to the network; below displays the two current VBA modules.

Private Sub Command20_Click()
DoCmd.SetWarnings False
Dim TblEmailPayments As Recordset
Dim strSql As String
Dim EmailAddress As String
Dim Contact As String
Dim FirstName As String
Dim FileName As String
Dim mess_body As String
Dim appOutLook As Outlook.Application
Dim MailOutLook As Outlook.MailItem
     Set appOutLook = CreateObject("Outlook.Application")
     Set MailOutLook = appOutLook.CreateItem(olMailItem)
Dim ContactEM As String
Dim FirstnameC As String
Dim SourceTable As String
    Set db = CurrentDb
    Set rstTables = db.OpenRecordset("TblEmailPayments")
Dim oApp, unzipfile, pathname, location
    Set oApp = CreateObject("Shell.Application")
    pathname = "S:\Finance\Accounting Operations\National Accounts\Databases\EmailedParplans\"
    location = [rstTables].[Contact]
    NewZip (pathname & location & ".zip")
    rstTables.MoveFirst
Do While Not rstTables.EOF
DoCmd.OpenQuery "QdelTblEmailPayTemp", acViewNormal, acEdit
     strSql = "INSERT INTO TblEmailPayTemp([Contact],[EmailAddress],[FirstName])" & _
     "SELECT TblEmailPayments.Contact, TblEmailPayments.EmailAddress, TblEmailPayments.FirstName FROM TblEmailPayments WHERE TblEmailPayments.Contact = " & Chr$(34) & rstTables.Contact & Chr$(34) & ";"
  FileName = "S:\Finance\Accounting Operations\National Accounts\Databases\EmailedParplans\" & [rstTables].[Contact] & "PCPM.xls"
FileNameR = "S:\Finance\Accounting Operations\National Accounts\Databases\EmailedParplans\" & [rstTables].[Contact] & "PCPM.pdf"
DoCmd.RunSQL strSql
DoCmd.TransferSpreadsheet acExport, acSpreadsheetTypeExcel9, "ParPlanDetails", "H:\" & [rstTables].[Contact] & "PCPM.xls", False, "CheckDetails"
DoCmd.TransferSpreadsheet acExport, acSpreadsheetTypeExcel9, "ParPlanSummary", "H:\" & [rstTables].[Contact] & "PCPM.xls", False, "WiredDetails"
    'DoCmd.OutputTo acOutputQuery, "ParPlanDetails", acFormatXLS, "C:\WINDOWS\MonthlyParplanDetail.xls", False, ""
    'FileCopy "C:\WINDOWS\MonthlyParplanDetail.xls", "Y:\EmailedParplans\MonthlyParplanDetail.xls"
    'Name "Y:\EmailedParplans\MonthlyParplanDetail.xls" As FileName
DoCmd.OutputTo acOutputReport, "Monthly_parplan_summary_detail_Email", acFormatPDF, "H:\" & [rstTables].[Contact] & "PCPM.pdf", False, ""
'DoCmd.OutputTo acOutputReport, "Monthly_parplan_summary_detail_Email", acFormatPDF, "H:\MonthlyParplanDetail.pdf", False, ""
    'FileCopy "C:\WINDOWS\MonthlyParplanDetail.pdf", "Y:\EmailedParplans\MonthlyParplanDetail.pdf"
    'Name "Y:\EmailedParplans\MonthlyParplanDetail.pdf" As FileNameR
Call ZipFiles
ContactEM = DLookup("Contact", "TblEmailPayTemp")
FirstnameC = DLookup("Firstname", "TblEmailPayTemp")
            Set appOutLook = CreateObject("Outlook.Application")
            Set MailOutLook = appOutLook.CreateItem(olMailItem)
            With MailOutLook
            .BodyFormat = olFormatHTML
            .To = DLookup("EmailAddress", "TblEmailPayTemp")
            .Subject = "Par Plan Reimbursement Details"
            .HTMLBody = (FirstnameC) & ",   " & "<BR>" & "<BR>" & _
            vbLf & "Attached is the detail Par Plan Reimbursement report(s) and spreadsheet(s), for servicing CareFirst members.  " & _
            "The check should arrive within the next couple of business days.  " & _
            (vbCr & vbLf & vbCrLf & vbCrLf & vbCrLf & vbCrLf & "Thank you for servicing our customers.") & "<BR>" & "<BR>" & _
            .Attachments.Add pathname & [rstTables].[Contact] & ".zip"
            '.Attachments.Add "C:\WINDOWS\MonthlyParplanDetail.pdf"
            '.DeleteAfterSubmit = True   'This would let Outlook send th note without storing it in your sent bin
             .Close 0 '0 = olSave
            End With
            rstTables.MoveNext
        Set MailOutLook = Nothing
           Loop
    Set oApp = Nothing
DoCmd.SetWarnings True
    Beep
    MsgBox "A zipped file with the Report and Spreadsheet was emailed to all Accounts and is in your Drafts folder!!!    PLEASE COPY THE REPORTS INTO THE APPROPRIATE MONTHLY FOLDER IN S:\Finance\Accounting Operations\National Accounts\Databases\EmailedParplans\"
End Sub

Private Sub ZipFiles()
Dim TblEmailPayments As Recordset
Dim Contact As String
Dim SourceTable As String
    Set db = CurrentDb
    Set rstTables = db.OpenRecordset("TblEmailPayTemp")
Set oApp = CreateObject("Shell.Application")
    pathname = "S:\Finance\Accounting Operations\National Accounts\Databases\EmailedParplans\"
    location = [rstTables].[Contact]
    NewZip (pathname & location & ".zip")
     oApp.NameSpace(pathname & location & ".zip").CopyHere "H:\" & [rstTables].[Contact] & "PCPM.xls"
    oApp.NameSpace(pathname & location & ".zip").CopyHere "H:\" & [rstTables].[Contact] & "PCPM.pdf"
    oApp.NameSpace(pathname & location & ".zip").CopyHere pathname & "item_settings.zip"
    Set oApp = Nothing
End Sub