Solved Error 6 Overflow

B

BuddyLee

New member
Local time
Today, 14:07
Joined
Jul 29, 2025
Messages
7
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.

Code: 
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
 
Last edited:
If you use the code tags it is easier to read for everyone. I did some indenting
Code: 
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
 
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.
 
Last edited:
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.
 
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
 
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?
 
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.

Code: 
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".
 
Those lines are commented out - so implies the issue is in your rename sub
 
BuddyLee said:
'Name conOutDir & "rpt.pdf" As conOutDir & strFile 'ie c:\CurlewFiles\OutEFiles\INVxxxxx-xxxxx.pdf
Click to expand...
Double check whether the concatenated paths are all valid.
My bet is: conOutDir is missing a backslash at the end.
 
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?
 
My bet is: conOutDir is missing a backslash at the end.
Click to expand...
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

Code: 
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.
 
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?

Code: 
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 _
 
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
 
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.
 
Something I've noted is at the top your code shows 'Date Last Modified: 07/18/07
The following sample code should give you an idea how easy this is currently. It creates the PDFs creates the EMails, and gets them ready to send out.

Code: 
Private Sub Btn_PrintAndEmail_Click()
    Dim MyRs As DAO.Recordset
    Dim strWhere As String
    Dim strFileName As String
    Dim REPORT_NAME As String = "Rpt_Test"
    Const QUERY_NAME As String = "QryTest"
    
    ' Hard code, use a variable, or pull the source for the current record
    ' set. Query is preferred as this allows for easier filtering.
    Set MyRs = CurrentDb.OpenRecordset(QUERY_NAME)

    With MyRs
        .MoveFirst
            Do While Not .EOF
                ' For each record in the returned recordset,
                ' Set the current filter to be the current Primary Key value
                ' This can be based on which report needs to be called.
                strWhere = "[TEST_ID] = " & MyRs!Test_ID
                
                ' Build up the path and file name for the output PDF file,
                ' CurrentProject.Path returns the path to where the databas is.
                ' Putting the files in the current directory, but "\" should be replaced with
                ' the child directory to print to. If another directory is preferred,
                ' CurrentProject.Path can be replaced with a value stored in a configuration record.
                strFileName = CurrentProject.Path & "\" & " (" & Format(MyRs!GenID, "00000000") & ") " & MyRs!GenName & ".pdf"
                
                'Take a look at what we are about to do to see if we are messing this up. Comment out this works right.
                ' MsgBox "Filter = " & strFilter & " / File = " & strFileName
                
                ' Open the report hidden so our filter can be applied
                ' Use a variable, hardcoded name, or table entry as appropriate to generage the proper report.
                DoCmd.OpenReport REPORT_NAME, acPreview, , strWhere, acHidden
                
                ' then output the report as a PDF, passing it the file name we want to save it as.
                DoCmd.OutputTo acOutputReport, REPORT_NAME, acFormatPDF, strFileName

                ' After the report is generated, close as we get ready to print the next record.
                DoCmd.Close acReport, REPORT_NAME
              
               ' then go to the next record.
               .MoveNext
            Loop
            .Close
    End With
    ' After we are done with the last record, clean up the recordset.
    Set MyRs = Nothing
End Sub

Private Sub Send_Email(pvAddress As Variant, pvSubject As Variant, pvAttachment As Variant)

    Dim EmailApp As Outlook.Application
    Dim NameSpace As Outlook.NameSpace
    Dim Folder As Outlook.Folder
    Dim EmailSend As Outlook.MailItem
          
    Set EmailApp = New Outlook.Application
    Set NameSpace = EmailApp.GetNamespace("MAPI")
    Set Folder = NameSpace.GetDefaultFolder(olFolderInbox)
    Set EmailSend = Folder.Items.Add(olMailItem)
    
    With EmailSend
        .To = pvAddress
        ‘Assign a deffered delivery time ONLY if a date/time to send is included.
        ‘.DeferredDeliveryTime = Date
        .Subject = "Generic Report for " & pvSubject
        .HTMLBody = "Please see the attached report. This has been customized just for you."
        .Attachments.Add (pvAttachment)
        .Display
        '.Send  '.send commented out as local config for outlook does not like auto-send.
    End With

    'When finished, release resources.
    Set EmailApp = Nothing
    Set NameSpace = Nothing
    Set Folder = Nothing
    Set EmailSend = Nothing
    
End Sub
 
Thank you all again.
I know some of the suggestions such as removing all API calls make sense to you, but I think that's even above my skillset!

The intloop count returned 2 which is correct as in test I'm just trying to create and send one invoice.
The file rename does happen before the error so I think that is okay.
I activated the Debug.Print !Email at that part of the CreatePDF and the result is the email address expected.

The next line of code is the SendEmail section. The email doesn't get sent in tests so perhaps that is where the problem lies?
I added a debug print immediately above Call SendEmail and the output is the proper email and the proper file location and name to be emailed.

But when turning off Error handler at top of the SendEmail code, the error handler still kicks in at failure.
So maybe the error is coming from the RenamePDF section.

The RenamePDF code is next.
Code: 
Public Sub ReNamePDF(strF As String)
    Dim T As Double
    Dim hWnd As LongPtr
    ' .....
    T = Timer
    hWnd = FindWindow(0&, "Printing")
    While IsWindow(hWnd)
      VBA.DoEvents
    Wend
    
Wait5:
    Debug.Print VBA.Err.Description
    VBA.Err.Clear
    While Timer - T < 5
        VBA.DoEvents
    Wend
    On Error Resume Next
    Name conOutDir & "rptInv.pdf" As conOutDir & strF  'ie c:\CurlewFiles\OutEFiles\INVxxxxx-xxxxx.pdf
    If VBA.Err.Number <> 0 Then GoTo Wait5
    '...
End Sub

The SendEmail code is below:
Code: 
Public Function SendEmail(strEAddress As String, strFileName As String)
    '************************************************************
    'Date Last Modified: 07/17/07
    'strEAddress is valid email address, strFileName is Invoice PDF created by CreatePDF
    'Purpose: Send Email using Persits software ASPMail
    'Requires: Run ASPEmail.exe found in Downloads\Access, Set reference to Persits
    'Called By: Repeatedly by FillArrayEmail and by CreatePDF (which is called by EMailBatch cmd under tasks)
    '************************************************************
    On Error GoTo ErrorHandler:
    Dim Mail As MailSender
    Set Mail = New MailSender
    
    Mail.Host = "smtp.gmail.com"
    Mail.UserName = "sales@haleventures.com"
    Mail.Password = "x"
    Mail.TLS = True
    ' Mail.Port = 587
    
    Mail.From = "sales@haleventures.com"
    Mail.FromName = "VoiceExchange" ' Optional
    Mail.AddAddress strEAddress '& "," & strName  ' Name is optional
        
    Mail.AddAttachment strFileName

    ' text format
    Mail.Subject = "Voice Mail Invoice"
    Mail.Body = "Dear VoiceMail Customer:" & vbCrLf & vbCrLf & "Thank you for your business.  Attached is your latest invoice." & _
        vbCrLf & vbCrLf & " " & _
        vbCrLf & vbCrLf & "If you have any questions, please contact us at 1-800-600-6699."
    'Mail.AppendBodyFromFile (conOutDir & strFileName)
    'Mail.Queue = True  'don't send, queue up see EmailAgent in control panel to configure queue dir as c:\CurlewFiles\emails
    Mail.Send
    
Exit_SendMail:
    Exit Function
ErrorHandler:
    basUtilities.ErrorHandler "basEmail", "SendMail"
    Resume Exit_SendMail

End Function
 
Just walk your code with F8 and perhaps some breakpoints, and report o which line you get the error.
 
Gasman said:
Just walk your code with F8 and perhaps some breakpoints, and report o which line you get the error.
Click to expand...
I forgot how to do this. The deceased programmed showed me this but it was 20 years ago!
It makes it into SendEmail
Set Mail = New MailSender

And the next step after that lines takes me to:
ErrorHandler:
basUtilities.ErrorHandler "basEmail", "SendMail"
 
You must log in or register to reply here.

Similar threads

AngelSpeaks
Need VBA Help with Printer Status
Replies
1
Views
896
June7
June7
oxicottin
Solved Out Of Memory error when emailing
Replies
8
Views
904
oxicottin
oxicottin
J
Expected =
Replies
2
Views
482
John Sh
J
B
Outlook - Filtered Unread, Server duplicate emails & think Unread = False not work so errors
Replies
6
Views
889
bignose2
B
C
Getting "The error 3061, Too few paramaters. Expected 6"
2
Replies
29
Views
3,234
Gasman
Gasman

Users who are viewing this thread

Total: 1 (members: 0, guests: 1)
Back
Top Bottom