Solved

Microsoft Access VBA using Windows 7

Posted on 2012-04-10
7
740 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
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
Complete VMware vSphere® ESX(i) & Hyper-V Backup

Capture your entire system, including the host, with patented disk imaging integrated with VMware VADP / Microsoft VSS and RCT. RTOs is as low as 15 seconds with Acronis Active Restore™. You can enjoy unlimited P2V/V2V migrations from any source (even from a different hypervisor)

 
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 500 total points
ID: 37829500
0

Featured Post

Enterprise Mobility and BYOD For Dummies

Like “For Dummies” books, you can read this in whatever order you choose and learn about mobility and BYOD; and how to put a competitive mobile infrastructure in place. Developed for SMBs and large enterprises alike, you will find helpful use cases, planning, and implementation.

Question has a verified solution.

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

Suggested Solutions

QuickBooks® has a great invoice interface that we were happy with for a while but that changed in 2001 through no fault of Intuit®. Our industry's unit names are dictated by RUS: the Rural Utilities Services division of USDA. Contracts contain un…
I see at least one EE question a week that pertains to using temporary tables in MS Access.  But surprisingly, I was unable to find a single article devoted solely to this topic. I don’t intend to describe all of the uses of temporary tables in t…
Familiarize people with the process of utilizing SQL Server stored procedures 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 Micr…
With Secure Portal Encryption, the recipient is sent a link to their email address directing them to the email laundry delivery page. From there, the recipient will be required to enter a user name and password to enter the page. Once the recipient …

786 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