Correctly attaching a Zip file using VBA to Email

Posted on 2012-08-23
Last Modified: 2012-08-23
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")
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
        Set MailOutLook = Nothing
    Set oApp = Nothing
DoCmd.SetWarnings True
    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 & ""
    Set oApp = Nothing
End Sub
Question by:CFMI
    LVL 1

    Accepted Solution

    Sometimes I have found Access running too fast. How about adding a delay between the two files.
    LVL 1

    Author Closing Comment

    Thank you, it worked and I screamed like the Ravens just scored a touchdown!  MS Access is just too fast - this is interesting and so true.

    Featured Post

    What Should I Do With This Threat Intelligence?

    Are you wondering if you actually need threat intelligence? The answer is yes. We explain the basics for creating useful threat intelligence.

    Join & Write a Comment

    Introduction When developing Access applications, often we need to know whether an object exists.  This article presents a quick and reliable routine to determine if an object exists without that object being opened. If you wanted to inspect/ite…
    In a multiple monitor setup, if you don't want to use AutoCenter to position your popup forms, you have a problem: where will they appear?  Sometimes you may have an additional problem: where the devil did they go?  If you last had a popup form open…
    Familiarize people with the process of utilizing SQL Server views from within Microsoft Access. Microsoft Access is a very powerful client/server development tool. One of the SQL Server objects that you can interact with from within Microsoft Access…
    Using Microsoft Access, learn some simple rules for how to construct tables in a relational database. Split up all multi-value fields into single values: Split up fields that belong to other things into separate tables: Make sure that all record…

    732 members asked questions and received personalized solutions in the past 7 days.

    Join the community of 500,000 technology professionals and ask your questions.

    Join & Ask a Question

    Need Help in Real-Time?

    Connect with top rated Experts

    16 Experts available now in Live!

    Get 1:1 Help Now