?
Solved

Microsoft Access VBA using Windows 7

Posted on 2012-04-10
7
Medium Priority
?
748 Views
Last Modified: 2012-04-20
Hello,

Last night my PC was upgraded using Windows 7 and today when running VBA to zip files an error message is displayed, "the file cannot be found or no read permission".  Did the upgrade cause the VBA needing to be rewritten?  A zip file is crated and attached but without the PDF file.

Can you please help as the VBA is shown below?

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] & "MPP.xls"
FileNameR = "S:\Finance\Accounting Operations\National Accounts\Databases\EmailedParplans\" & [rstTables].[Contact] & "MPP.pdf"
DoCmd.RunSQL strSql
DoCmd.TransferSpreadsheet acExport, acSpreadsheetTypeExcel9, "ParPlanDetails", "H:\MonthlyParplanDetail.xls", False, "CheckDetails"
DoCmd.TransferSpreadsheet acExport, acSpreadsheetTypeExcel9, "ParPlanSummary", "H:\MonthlyParplanDetail.xls", False, "WiredDetails"
DoCmd.OutputTo acOutputReport, "Monthly_parplan_summary_detail_Email", acFormatPDF, "H:\MonthlyParplanDetail.pdf", False, ""
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.  " & _
            "If you have any questions, please contact " & _
            "Zainab Ogunbajo at (410) 998-5860 or email Zainab.Ogunbajo@carefirst.com." & "<BR>" & "<BR>" & "<BR>" & "<BR>" & _
            (vbCr & vbLf & vbCrLf & vbCrLf & vbCrLf & vbCrLf & "Thank you for servicing our customers.") & "<BR>" & "<BR>" & "<BR>" & "<BR>" & _
            "Zainab Ogunbajo " & "<BR>" & _
            "ACCOUNTANT I" & "<BR>" & _
            "Phone: 410-998-5860" & "<BR>" & _
            "Mail Stop 01-660"
            .Attachments.Add pathname & [rstTables].[Contact] & ".zip"
            .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:\MonthlyParplanDetail.xls"
    oApp.NameSpace(pathname & location & ".zip").CopyHere "H:\MonthlyParplanDetail.pdf"
    oApp.NameSpace(pathname & location & ".zip").CopyHere pathname & "item_settings.zip"
    Set oApp = Nothing
End Sub
0
Comment
Question by:CFMI
[X]
Welcome to Experts Exchange

Add your voice to the tech community where 5M+ people just like you are talking about what matters.

  • Help others & share knowledge
  • Earn cash & points
  • Learn & ask questions
7 Comments
 
LVL 74

Expert Comment

by:Jeffrey Coachman
ID: 37828649
What version of Win 7 please?

< Did the upgrade cause the VBA needing to be rewritten?>
No, but some things in VBA are not allowed anymore in Win 7 directly.

Many times API calls must be modified to work properly on 64 bit Win 7...
0
 
LVL 21
ID: 37828650
Can you be more specific on what was upgraded?

Which kine of code is generating the error?

What is NewZip ()  ?
0
 
LVL 1

Author Comment

by:CFMI
ID: 37828717
Last night I received Windows 7 Enterprise system (service pack 1) - 64 bit. Oh, no does this need the API to be modified?

Sub NewZip(sPath)
'Create empty Zip File
'Changed by keepITcool Dec-12-2005
    If Len(Dir(sPath)) > 0 Then Kill sPath
    Open sPath For Output As #1
    Print #1, Chr$(80) & Chr$(75) & Chr$(5) & Chr$(6) & String(18, 0)
    Close #1

End Sub
0
10 Questions to Ask when Buying Backup Software

Choosing the right backup solution for your organization can be a daunting task. To make the selection process easier, ask solution providers these 10 key questions.

 
LVL 77

Expert Comment

by:peter57r
ID: 37828900
Can you still see an S drive in Windows Explorer?
Perhaps your 'upgrade' has removed some mappings?
0
 
LVL 1

Author Comment

by:CFMI
ID: 37829050
Windows Explorer shows our S drive.  Also, the zip file is placed in the correct path but it doesn't contain the PDF file.
0
 
LVL 74

Expert Comment

by:Jeffrey Coachman
ID: 37829494
<Last night I received Windows 7 Enterprise system (service pack 1) - 64 bit. Oh, no does this need the API to be modified?>
Probably...
0
 
LVL 74

Accepted Solution

by:
Jeffrey Coachman earned 2000 total points
ID: 37829500
0

Featured Post

VIDEO: THE CONCERTO CLOUD FOR HEALTHCARE

Modern healthcare requires a modern cloud. View this brief video to understand how the Concerto Cloud for Healthcare can help your organization.

Question has a verified solution.

If you are experiencing a similar issue, please ask a related question

You need to know the location of the Office templates folder, so that when you create new templates, they are saved to that location, and thus are available for selection when creating new documents.  The steps to find the Templates folder path are …
Microsoft Access is a place to store data within tables and represent this stored data using multiple database objects such as in form of macros, forms, reports, etc. After a MS Access database is created there is need to improve the performance and…
In Microsoft Access, learn the trick to repeating sub-report headings at the top of each page. The problem with sub-reports and headings: Add a dummy group to the sub report using the expression =1: Set the “Repeat Section” property of the dummy…
Access reports are powerful and flexible. Learn how to create a query and then a grouped report using the wizard. Modify the report design after the wizard is done to make it look better. There will be another video to explain how to put the final p…
Suggested Courses

765 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