MS Access VBA does not attach zip file to email

Experts,

Please assist by identifying the correction of the error message listed below.

After receiving the message, the attachment VBA statement was highlighted so I checked the directory of the zip file and nothing was incorrect; therefore, the code should be able to locate.

Thank you in advance for your help!

Error message:
cannot open the file: mk:@MSITStore:C:\Program Files (x86)\Common Files\Microsoft Shared\Office12\1033\jeterr40.chm

VBA:
Private Sub SelecteEmailBill_Click()
If IsNull(Forms![FrmMain]!SpecificVendor) Then
        MsgBox "Please Select a Plan!!!"
 Else

DoCmd.SetWarnings False
Dim TblEmailPayTemp 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 rstTblzip = db.OpenRecordset("TblEmailPayTemp")

Dim oApp, unzipfile, pathname, location
 
    Set oApp = CreateObject("Shell.Application")
    pathname = "S:\Vendor Fee Billing\TempBills\"
    location = [rstTblzip].[FileName]
    NewZip (pathname & location & ".zip")

       
rstTblzip.MoveFirst

DoCmd.OpenQuery "QdelTblEmailPayTemp", acViewNormal, acEdit
DoCmd.OpenQuery "QappTblEmailPaymentsTempSelected", acViewNormal, acEdit

'FileName = "S:\Vendor Fee Billing\TempBills\" & [rstTblzip].[Contact] & "MPP.xls"
'FileNameR = "S:\Vendor Fee Billing\TempBills\" & [rstTblzip].[Contact] & "MPP.pdf"

DoCmd.OutputTo acOutputQuery, "1f5_Email", acFormatXLS, "H:\MonthlyCFVendorFeeInvoice.xls", False, ""

Dim xlApp As Object, xlWb As Object, xlWs As Object

Set xlApp = CreateObject("Excel.Application")

Set xlWb = xlApp.Workbooks.Open("H:\MonthlyCFVendorFeeInvoice.xls")

For Each xlWs In xlWb.Worksheets

    xlWs.PageSetUp.Orientation = 2 'xlLandscape

Next

xlWb.Save

xlWb.Close

Set xlWs = Nothing

Set xlWb = Nothing

xlApp.Quit

Set xlApp = Nothing

DoCmd.OutputTo acOutputReport, "Monthly_parplan_summary_detail_Email", acFormatPDF, "H:\MonthlyCFVendorFeeInvoice.pdf", False, ""

Pause (0.5) 'for a half second pause

'FileCopy "H:\MonthlyCFVendorFeeInvoice.xls", "H:\" & "AAA" & [rstTblzip].[Contact] & ".xls"
'FileCopy "H:\MonthlyCFVendorFeeInvoice.pdf", "H:\" & "AAA" & [rstTblzip].[Contact] & ".pdf"


Call ZipFiles
Pause (4.5) 'for a one and a half second pause
ContactEM = DLookup("[FileName]", "TblEmailPayTemp")
FirstnameC = DLookup("FirstName", "TblEmailPayTemp")
            Set appOutLook = CreateObject("Outlook.Application")
            Set MailOutLook = appOutLook.CreateItem(olMailItem)
            With MailOutLook
            .BodyFormat = olFormatHTML
            .To = DLookup("EmailAddress", "TblEmailPayTemp")
            .Subject = "SECURE CareFirst(Host) VendorFees Invoice to Home Plan"
            .HTMLBody = (FirstnameC) & ",   " & "<BR>" & "<BR>" & _
            "Please find attached new invoices and backup data for Third Party Vendor fee reimbursements as we are catching up with outstanding vendor fees for your plans. " & _
            "When mailing us a check, please make sure to list our mail stop number 01-660 in the address. " & _
            "Feel free to contact me if you have any questions. " & _
            (vbCr & vbLf & vbCrLf & vbCrLf & vbCrLf & vbCrLf & "Thank you for a prompt response to this matter.") & "<BR>" & "<BR>" & _
            "NOTICE: This email message is for the sole use of the intended recipient(s) and may contain confidential and privileged information. Any unauthorized review, use, disclosure " & _
            "or distribution is prohibited. If you are not the intended recipient, please contact the sender by reply email and destroy all copies of the original message."
            .Attachments.Add "S:\Vendor Fee Billing\TempBills\" & [rstTblzip].[FileName] & ".zip"
            .Close 0
            End With
            rstTables.MoveNext
        Set MailOutLook = Nothing
    'Call KillSomeTime
    Set oApp = Nothing
DoCmd.SetWarnings True
    Beep
    MsgBox "A zipped file with the Report and Spreadsheet was created for the Selected Plan!!! Check Outlook Draft Folder for e-mail details"
    End If
End Sub
LVL 1
CFMIFinancial Systems AnalystAsked:
Who is Participating?
I wear a lot of hats...

"The solutions and answers provided on Experts Exchange have been extremely helpful to me over the last few years. I wear a lot of hats - Developer, Database Administrator, Help Desk, etc., so I know a lot of things but not a lot about one thing. Experts Exchange gives me answers from people who do know a lot about one thing, in a easy to use platform." -Todd S.

Rey Obrero (Capricorn1)Commented:
try replacing your "map network drive" using the UNC (universal naming convention)

sample, this

"S:\Vendor Fee Billing\TempBills\" & [rstTblzip].[FileName] & ".zip"

must be

"\\Servername\sharedFolderName\Vendor Fee Billing\TempBills\" & [rstTblzip].[FileName] & ".zip"
1

Experts Exchange Solution brought to you by

Your issues matter to us.

Facing a tech roadblock? Get the help and guidance you need from experienced professionals who care. Ask your question anytime, anywhere, with no hassle.

Start your 7-day free trial
CFMIFinancial Systems AnalystAuthor Commented:
It works with this code but this selects the entire list...
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:\Vendor Fee Billing\TempBills\"
    location = [rstTables].[FileName]
    NewZip (pathname & location & ".zip")

       
rstTables.MoveFirst

Do While Not rstTables.EOF
DoCmd.OpenQuery "QdelTblEmailPayTemp", acViewNormal, acEdit
     strSql = "INSERT INTO TblEmailPayTemp([Contact],[EmailAddress],[FirstName],[FileName])" & _
     "SELECT TblEmailPayments.Contact, TblEmailPayments.EmailAddress, TblEmailPayments.FirstName, TblEmailPayments.[FileName] FROM TblEmailPayments WHERE TblEmailPayments.Contact = " & Chr$(34) & rstTables.Contact & Chr$(34) & ";"

     
FileName = "S:\Vendor Fee Billing\TempBills\" & [rstTables].[Contact] & "MPP.xls"
FileNameR = "S:\Vendor Fee Billing\TempBills\" & [rstTables].[Contact] & "MPP.pdf"
DoCmd.RunSQL strSql
DoCmd.OutputTo acOutputQuery, "1f5_Email", acFormatXLS, "H:\MonthlyCFVendorFeeInvoice.xls", False, ""

Dim xlApp As Object, xlWb As Object, xlWs As Object

Set xlApp = CreateObject("Excel.Application")

Set xlWb = xlApp.Workbooks.Open("H:\MonthlyCFVendorFeeInvoice.xls")

For Each xlWs In xlWb.Worksheets

    xlWs.PageSetUp.Orientation = 2 'xlLandscape

Next

xlWb.Save

xlWb.Close

Set xlWs = Nothing

Set xlWb = Nothing

xlApp.Quit

Set xlApp = Nothing

DoCmd.OutputTo acOutputReport, "Monthly_parplan_summary_detail_Email", acFormatPDF, "H:\MonthlyCFVendorFeeInvoice.pdf", False, ""

Pause (0.5) 'for a half second pause

FileCopy "H:\MonthlyCFVendorFeeInvoice.xls", "H:\" & "AAA" & [rstTables].[Contact] & ".xls"
FileCopy "H:\MonthlyCFVendorFeeInvoice.pdf", "H:\" & "AAA" & [rstTables].[Contact] & ".pdf"


Call ZipFiles
Pause (0.5) 'for a half second pause
ContactEM = DLookup("[FileName]", "TblEmailPayTemp")
FirstnameC = DLookup("Firstname", "TblEmailPayTemp")
            Set appOutLook = CreateObject("Outlook.Application")
            Set MailOutLook = appOutLook.CreateItem(olMailItem)
            With MailOutLook
            .BodyFormat = olFormatHTML
            .To = DLookup("EmailAddress", "TblEmailPayTemp")
            .Subject = "SECURE CareFirst(Host) VendorFees Invoice to Home Plan"
            .HTMLBody = (FirstnameC) & ",   " & "<BR>" & "<BR>" & _
            "Please find attached new invoices and backup data for Third Party Vendor fee reimbursements as we are catching up with outstanding vendor fees for your plans. " & _
            "When mailing us a check, please make sure to list our mail stop number 01-660 in the address. " & _
            "Feel free to contact me if you have any questions. " & _
            (vbCr & vbLf & vbCrLf & vbCrLf & vbCrLf & vbCrLf & "Thank you for a prompt response to this matter.") & "<BR>" & "<BR>" & _
            "NOTICE: This email message is for the sole use of the intended recipient(s) and may contain confidential and privileged information. Any unauthorized review, use, disclosure " & _
            "or distribution is prohibited. If you are not the intended recipient, please contact the sender by reply email and destroy all copies of the original message."
            .Attachments.Add "S:\Vendor Fee Billing\TempBills\" & [rstTables].[FileName] & ".zip"
            .Close 0
            End With
            rstTables.MoveNext
        Set MailOutLook = Nothing
    'Call KillSomeTime
    Loop
    Set oApp = Nothing
DoCmd.SetWarnings True
    Beep
    MsgBox "A zipped file with the Report and Spreadsheet was created for all Accounts!!! Check Outlook Draft Folder for e-mail details"

End Sub
0
CFMIFinancial Systems AnalystAuthor Commented:
I tried using the UNC and it displayed an error message, "Record is deleted and run time error 3167".  Debugging displays the Attachment statement.

.Attachments.Add "\\carefirst.com\corp\shared\Vendor Fee Billing\TempBills\" & [rstTables].[FileName] & ".zip"
0
CFMIFinancial Systems AnalystAuthor Commented:
Turns out, it was the File Name, at that point in time - Thank You!
0
It's more than this solution.Get answers and train to solve all your tech problems - anytime, anywhere.Try it for free Edge Out The Competitionfor your dream job with proven skills and certifications.Get started today Stand Outas the employee with proven skills.Start learning today for free Move Your Career Forwardwith certification training in the latest technologies.Start your trial today
Microsoft Access

From novice to tech pro — start learning today.