Error 6 Overflow (4 Viewers)

[BuddyLee]

I have little experience with Access other than trial and error changes and forums like this helping me out.
Original owner of our company taught me a few things many years ago but he has since passed away so here I am.
This section of code works fine on Office 365 32 bit but will not function on a 64 bit version. I'd like to change that.
The Dim intLoop and intx statements used to be "Integer". I've changed them to "Long" and it does not correct the issue.
Any help would be greatly appreciated.

Public Function CreatePDF(Optional strCalling As String)

    '************************************************************

    'Date Last Modified: 07/18/07

    'Purpose: Loop through xtblRptInv for email custs and create PDFs from rptInv

    'Requires: Bullzip PDF Printer, and setting of printer directory to conOutDir & rptInv.pdf

               'Also set confirms etc to no and never.

               'Double Click icon to set printer properties.

    'Called By: Tasks cmdEMAILBatch,  ReLoadInvoice("ReEmail")and ReprintBatch this is the only one that uses strCalling

    '************************************************************

    Dim db As Database

    Dim rsMailingList As Recordset

    Dim strDefPrn As String, strPDFPrn As String, strFile As String, strSQL As String

    Dim prnPDF As Printer

    Dim prnDef As Printer

    Dim intLoop As Long

    Dim varRet As Variant

    Dim intx As Long

    Set db = CurrentDb

  

    'Dim sw As New StopWatch

    'Set sw = New StopWatch

  

    

    'in case of failure there will be files created in previous run

    On Error Resume Next

    Kill conOutDir & "*.*"

    On Error GoTo ErrorHandler:

  

    'get the current msaccess default printer, so can reset

    strDefPrn = Application.Printer.DeviceName

    'check if this printer name is in printers collection

    strPDFPrn = "Bullzip PDF Printer"

    'error if not

    Set prnPDF = Application.Printers(strPDFPrn)

    'set the msaccess printer to the PDF printer

    Set Application.Printer = Application.Printers(strPDFPrn)

      

    'cmdEmailBatch calls with no parameter, and RePrintBatch if answer yes to Email?

    If strCalling = "" Then

        'set rptInv record source to email qry (only difference is parameter custno and InvByEmail = True)

        DoCmd.OpenReport "rptInv", acViewDesign, , , acHidden

            Reports("rptInv").RecordSource = "qryInvRptEmail"

        DoCmd.Close acReport, "rptInv", acSaveYes

        strSQL = MailList(True) 'limit to only EmailByInvoice

    Else

        'single coming from frmPopInvoices called with ReLoad as parameter was stopped there if no email address

        DoCmd.OpenReport "rptInv", acViewDesign, , , acHidden

            Reports("rptInv").RecordSource = "qryInvRpt0"

        DoCmd.Close acReport, "rptInv", acSaveYes

        strSQL = MailList(False) 'not limited as above, only needs an email address, not InvByEmail

    End If

  

    Set rsMailingList = db.OpenRecordset(strSQL)

  

    With rsMailingList

        .MoveLast

        .MoveFirst

        'set the max meter value to record count

        varRet = SysCmd(acSysCmdInitMeter, "Creating PDF files from Invoice ", .RecordCount)

      

        DoCmd.OpenForm "frmEInv", , , , , acHidden

        intLoop = 1

        Do Until .EOF

            varRet = SysCmd(acSysCmdUpdateMeter, intLoop)

            intLoop = intLoop + 1

          

            'provides parameter to qryInvRptEmail so report creates that pdf (no effect on reloadinvoice call)

            Forms!frmEInv!txtCustno = !CUSTNO

            'recordsource will be qryInvByEmail or qryInvRpt0

            'creates file in conOutDir (VoiceMailInvoice.pdf) since printer is now pdf printer and printer is set to dir and fname

            DoCmd.OpenReport "rptInv", , , , acHidden

        

            strFile = "INV" & !InvNo & ".pdf" 'desired new name INVxxxx-xxxxx.pdf

            'rename the file this fails with err.number=53 see errorhandler. Creation of rpt.pdf

            'takes a really variable time.  So just loop with resume on error.

            'sw.StartTimer  'about 14 secs first loop then 4 secs each succeding

            'intx = 0

            Call ReNamePDF(strFile)

            'Name conOutDir & "rpt.pdf" As conOutDir & strFile  'ie c:\CurlewFiles\OutEFiles\INVxxxxx-xxxxx.pdf

            'Debug.Print sw.ElapsedTime

          

            'Debug.Print strFile

            'Debug.Print !Email

            'Call SendEmail(!Email, conOutDir & "VoiceMailInvoice.pdf")

            Call SendEmail(!Email, conOutDir & strFile)

            'Kill conOutDir & "VoiceMailInvoice.pdf"

            Kill conOutDir & strFile

            .MoveNext

        Loop

    End With  'rsMailingList

  

    ''->If strCalling = "" Then

        'Call FillArrayEmail

    'Else

        'Call FillArrayEmail("ReLoad")

    'End If

  

    varRet = SysCmd(acSysCmdClearStatus)

  

Exit_CreatePDF:

    'reset all back to original state

    DoCmd.OpenReport "rptInv", acViewDesign, , , acHidden

    Reports("rptInv").RecordSource = "qryInvRpt"

    DoCmd.Close acReport, "rptInv", acSaveYes

    Set prnDef = Application.Printers(strDefPrn)

    Set Application.Printer = Application.Printers(strDefPrn)

    DoCmd.Close acForm, "frmEInv"

    Exit Function

ErrorHandler:

    Select Case Err.Number

        Case 53, 75 ' file not found.  Occurs at "Name conPDFDir " 75 is no access to dir

            'loop until PDF creation is finished, resume starts again with line that caused error

            intx = intx + 0

            Resume

        Case Else

            basUtilities.ErrorHandler "basEmail", "CreatePDF"

            Resume Exit_CreatePDF

    End Select

End Function

 

[MajP]

If you use the code tags it is easier to read for everyone. I did some indenting

Public Function CreatePDF(Optional strCalling As String)
'************************************************************
'Date Last Modified: 07/18/07
'Purpose: Loop through xtblRptInv for email custs and create PDFs from rptInv
'Requires: Bullzip PDF Printer, and setting of printer directory to conOutDir & rptInv.pdf
'Also set confirms etc to no and never.
'Double Click icon to set printer properties.
'Called By: Tasks cmdEMAILBatch, ReLoadInvoice("ReEmail")and ReprintBatch this is the only one that uses strCalling
'************************************************************
Dim db As Database
Dim rsMailingList As Recordset
Dim strDefPrn As String, strPDFPrn As String, strFile As String, strSQL As String
Dim prnPDF As Printer
Dim prnDef As Printer
Dim intLoop As Long
Dim varRet As Variant
Dim intx As Long
Set db = CurrentDb

'Dim sw As New StopWatch
'Set sw = New StopWatch


'in case of failure there will be files created in previous run
On Error Resume Next
Kill conOutDir & "*.*"
On Error GoTo ErrorHandler:

'get the current msaccess default printer, so can reset
strDefPrn = Application.Printer.DeviceName
'check if this printer name is in printers collection
strPDFPrn = "Bullzip PDF Printer"
'error if not
Set prnPDF = Application.Printers(strPDFPrn)
'set the msaccess printer to the PDF printer
Set Application.Printer = Application.Printers(strPDFPrn)

'cmdEmailBatch calls with no parameter, and RePrintBatch if answer yes to Email?
If strCalling = "" Then
    'set rptInv record source to email qry (only difference is parameter custno and InvByEmail = True)
    DoCmd.OpenReport "rptInv", acViewDesign, , , acHidden
    Reports("rptInv").RecordSource = "qryInvRptEmail"
    DoCmd.Close acReport, "rptInv", acSaveYes
    strSQL = MailList(True) 'limit to only EmailByInvoice
Else
'single coming from frmPopInvoices called with ReLoad as parameter was stopped there if no email address
    DoCmd.OpenReport "rptInv", acViewDesign, , , acHidden
    Reports("rptInv").RecordSource = "qryInvRpt0"
    DoCmd.Close acReport, "rptInv", acSaveYes
    strSQL = MailList(False) 'not limited as above, only needs an email address, not InvByEmail
End If

Set rsMailingList = db.OpenRecordset(strSQL)

With rsMailingList
    .MoveLast
    .MoveFirst
    'set the max meter value to record count
    varRet = SysCmd(acSysCmdInitMeter, "Creating PDF files from Invoice ", .RecordCount)
    
    DoCmd.OpenForm "frmEInv", , , , , acHidden
    intLoop = 1
    Do Until .EOF
        varRet = SysCmd(acSysCmdUpdateMeter, intLoop)
        intLoop = intLoop + 1
        
        'provides parameter to qryInvRptEmail so report creates that pdf (no effect on reloadinvoice call)
        Forms!frmEInv!txtCustno = !CUSTNO
        'recordsource will be qryInvByEmail or qryInvRpt0
        'creates file in conOutDir (VoiceMailInvoice.pdf) since printer is now pdf printer and printer is set to dir and fname
        DoCmd.OpenReport "rptInv", , , , acHidden
        
        strFile = "INV" & !InvNo & ".pdf" 'desired new name INVxxxx-xxxxx.pdf
        'rename the file this fails with err.number=53 see errorhandler. Creation of rpt.pdf
        'takes a really variable time. So just loop with resume on error.
        'sw.StartTimer 'about 14 secs first loop then 4 secs each succeding
        'intx = 0
        Call ReNamePDF(strFile)
        'Name conOutDir & "rpt.pdf" As conOutDir & strFile 'ie c:\CurlewFiles\OutEFiles\INVxxxxx-xxxxx.pdf
        'Debug.Print sw.ElapsedTime
        
        'Debug.Print strFile
        'Debug.Print !Email
        'Call SendEmail(!Email, conOutDir & "VoiceMailInvoice.pdf")
        Call SendEmail(!Email, conOutDir & strFile)
        'Kill conOutDir & "VoiceMailInvoice.pdf"
        Kill conOutDir & strFile
        .MoveNext
        Loop
    End With 'rsMailingList

''->If strCalling = "" Then
'Call FillArrayEmail
'Else
'Call FillArrayEmail("ReLoad")
'End If

varRet = SysCmd(acSysCmdClearStatus)

Exit_CreatePDF:
'reset all back to original state

DoCmd.OpenReport "rptInv", acViewDesign, , , acHidden
Reports("rptInv").RecordSource = "qryInvRpt"
DoCmd.Close acReport, "rptInv", acSaveYes
Set prnDef = Application.Printers(strDefPrn)
Set Application.Printer = Application.Printers(strDefPrn)
DoCmd.Close acForm, "frmEInv"

Exit Function
ErrorHandler:

Select Case Err.Number
    Case 53, 75 ' file not found. Occurs at "Name conPDFDir " 75 is no access to dir
    'loop until PDF creation is finished, resume starts again with line that caused error
        intx = intx + 0
        Resume
    Case Else
        basUtilities.ErrorHandler "basEmail", "CreatePDF"
        Resume Exit_CreatePDF
End Select

End Function

 

[June7]

First, please post code between CODE tags to retain indentation and readability.
Second, what line triggers overflow error?

I don't immediately see anything that would prevent code running in 64-bit.

 

[MajP]

Does this code break at a certain place?
Personally, I would rewrite a lot of this thing. I would never be opening forms and reports in design view and then saving them. As far as I can tell there is no need to do this anyways. I am not sure why they do this.

However, without knowing where the code breaks it will be near impossible because this code calls a lot of other methods that are not shown. They include
renamePDF
sendEmail
maillist

If the code is breaking outside of the procedure, we do not even know what these do. However as said, I do not see a 64 bit issue unless those methods are window API methods.

However you are right in looking to see if an integer is overflowing. But if in a infinite loop you can overflow anything.

 

[BuddyLee]

Sorry about that!
It functions properly until this point:
'Name conOutDir & "rpt.pdf" As conOutDir & strFile 'ie c:\CurlewFiles\OutEFiles\INVxxxxx-xxxxx.pdf
As the PDF does get created and renamed.
Then I get an "An error has prevented this operation from completing"
And in our error log table an entry for Error Code 6, Overflow error is logged. From form basEmail and procedure CreatePDF

 

[CJ_London]

I presume you do have the bullzip printer installed and works with 64bit?

There are a number of things which could be simpler. For example you can outputTo a report to pdf

Rather than opening the report in design view to change the recordsource you can name the query in the filter name parameter of openreport or perhaps using the where parameter to provide a filter

As others have said- how does the error manifest itself? On compile? on a particular line in which case which line and what is the error description? Something doesn’t happen as expected? In which case what is supposed to happen? And what actually happens?

 

[June7]

Disable the error handler and step through code.
You could provide db for analysis. Maybe someone is running 64-bit Access and will look at. Not me.

 

[MajP]

In addition to what has bee said, if I was trying to debug, my first step would be to add a debug.print to see if this loop is running away.

Do Until .EOF
        varRet = SysCmd(acSysCmdUpdateMeter, intLoop)
        intLoop = intLoop + 1

        debug.print intLoop
     ...
        .MoveNext
        Loop

The thought is that an error 6 overflow may happen if you exceed the limits of the variable which happens often when you are in an infinite loop.

or something like
if intLoop > 1000 then Msgbox "running away".

 

[CJ_London]

Those lines are commented out - so implies the issue is in your rename sub

 

[MajP]

Those lines are commented out - so implies the issue is in your rename sub

That means we need to see the rename code..

 

[sonic8]

'Name conOutDir & "rpt.pdf" As conOutDir & strFile 'ie c:\CurlewFiles\OutEFiles\INVxxxxx-xxxxx.pdf

Double check whether the concatenated paths are all valid.
My bet is: conOutDir is missing a backslash at the end.

 

[gemma-the-husky]

Do you have an active "timer" function. If that uses gettickcount, then it needs to use a 64bit version, not the 32bit.
It's commented out here. Any other API functions need to be checked as well

It's not really useful showing us code that ought to run. We need to see where the problem is caused.

Doesn't Access 64-bit show you what is causing the error?

 

[MajP]

My bet is: conOutDir is missing a backslash at the end.

This is a good point and you inherited this you may want to do it different.

Somewhere in your code at the top of a module you have a module level constant, conOutDir
It is not in this procedure as a procedure level constant.
Since it is a constant that means it is hardwired to the application. It requires you to manually update this if something changes in your directory structure.

I would probably do something like put a subfolder in the same folder as the application. This folder has only one purpose. You download attachements, email them, then delete them. It is a holding folder.

If would add these functions to easily get (create) the out put directory and then clear it when needed.

then simply get the output folder using
GetOutPath
and clear this folder
EmptyOutDir

Public Function GetOutPath() As String
 
  Dim currentPath As String
  Dim fso As Object
  
  Set fso = CreateObject("Scripting.FileSystemObject")
  currentPath = CurrentProject.Path & "\"
  If Not fso.folderexists(currentPath & "OutDir") Then
    fso.createfolder (currentPath & "OutDir")
  End If
  GetOutPath = currentPath & "OutDir" & "\"
End Function
Public Sub EmptyOutDir()
    On Error GoTo EmptyOutDir_Error
  Dim OutDir As String
  Dim fso As Object
  Set fso = CreateObject("Scripting.FileSystemObject")
 
  OutDir = GetOutPath()
  fso.DeleteFile OutDir & "*.*", False

    
    On Error GoTo 0
    Exit Sub

EmptyOutDir_Error:
    If Err.Number = 70 Then
      MsgBox "You have files open in the Out directory. Please close them first.", vbInformation, "Open Files"
      Resume
    Else
      MsgBox "Error " & Err.Number & " (" & Err.Description & ") in procedure EmptyOutDir, line " & Erl & "."
    End If
End Sub

This assumes you have permissions to the folder where your application resides

Now you will not have to worry abut manually updated a constant and ensuring that path exists.

 

[BuddyLee]

Thank you for the assistance so far.
The constant seems to be ok - Const conOutDir = "c:\CurlewFiles\OutEFiles\"

I noticed a reference to "user32" near the top of my Declarations and a quick google indicates this may be an issue?

Public Declare PtrSafe Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal _
ClassName As Any, ByVal AppCaption As Any) As Long

Public Declare PtrSafe Function IsWindow Lib "user32" (ByVal hWnd As Long) As _

 

[CJ_London]

Hwnd should be longptr as I think should findwindow. Not sure about iswindow you haven’t shown the type

Also need to change any dims where you are assigning hwnd

 

[CJ_London]

See this link- you can check all your api calls

https://gist.github.com/KallunWillock/11d2e4d1e4476970f8f82a495eeb4dc6

 

[MajP]

Stop wasting your time and simply get rid of all API calls. It is highly unlikely that you need them to do anything. They are likely just some window dressing, and if you are not an advanced programmer you will just waste time dealing with it.