Hello all. I signed up here to ask for some help with the code I am going to post. The code works, but I sure it is not the
most efficient way to do what I am doing and there are some problems that arise after many hours of execution that have
baffled me to the point I need fresh eyes and more excel knowledgeable people to look at it.
In a nutshell, this
code is behind a report that has to print each morning at 7am or desired time and generate a .csv file for storage backup of
the data. It is also triggering database queries once an hour for new data. I give the user input boxes to set the Print
time, view minutes and seconds to next update of data, I display current time to be compared with Next Print Time and give
them input boxes to give a file path where the csv file will be written. It all works fine.....for a while.
think my problem stems from keeping the time displayed accurately in a cell for viewing and using it for the compare to know
when to print and save.
What I have noticed is that the longer the code runs, the more it loads up on memory and
processor time to the point it will eventually crash. I have tried to slow the code down with WAIT commands, Sleep commands
and experimented with some For/While looping but all of my attempts have affected either the time updating or paused function
of the spreadsheet while waiting or sleeping.
I don't do a lot of excel vba so my methodology may be laughable,
but for better or worse, here it is. Any help with this will be much appreciated.
With the exception of a couple
of buttons coming from Sheet1 writing to Global bits, all code is in this one module. A screenshot of the user input area is
also attached. Thank you.
Global Poll_Timer As Integer
Global RunCode As Boolean
Dim Timer_Interval As Double
Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
PollTimer = 1 'On Open Start Poll Timer Counts at 1
Dim Interval As Double
RunCode = True 'Set True at Startup
Interval = CDbl(Range("L1").Value) 'Get the Interval Value (For Time Incrementing) from Cell L1
Sub Timer(Optional ByVal Interval As Double)
If Interval > 0 Then Timer_Interval = Interval 'Sends Interval Time from Cell L1 if > 0
If Timer_Interval > 0 Then Application.OnTime (Now + Timer_Interval), "FcCalls" 'Update Time + 1 sec
Sub FcCalls() 'Sub to call all System Functions
If RunCode = True Then
Sheet1.txtTime.Value = CStr(Time) 'Updates Current Time Cell
Dim Poll_Timer_Countdown As Integer
Dim fPath As String
Dim fName As String
Dim fName_Print As String
fPath = Sheet1.Range("G5") 'Get file path from Cell G5
fName = Sheet1.Range("M6") 'Get file name from Cell M6
strDate = Format(Date, "_mm_dd_yy") 'Append date stamp to filename for unique ID
Sheet1.txtWritePath.Value = fPath & fName & strDate 'Update Current Save Path to Cell H3
fName_Print = fPath & fName & strDate 'Generate file name for saving file
Poll_Timer = Poll_Timer + 1 'Increment in seconds a poll timer for poll trigger
Poll_Timer_Countdown = 3600 - Poll_Timer 'Reverse second output for countdown to next poll
Sheet1.txtNextPoll.Value = Poll_Timer_Countdown 'Display poll countdown in seconds
Sheet1.txtNextPollMin.Value = Format(Poll_Timer_Countdown / 60, "00.00") 'Display poll countdown in minutes
If Poll_Timer_Countdown < 1 Then
Sheet1.Range("A1") = Now() 'Change value in Cell A1 to Prompt New Poll
Poll_Timer = 1 'Resets for Next Poll
If Sheet1.txtPrintTime.Value = Sheet1.txtTime.Value Then
On Error GoTo PrintError
Sheet1.PrintOut 'Print Report at Set Time
On Error GoTo FileError
Sleep (1000) 'Pause 1 second before continuing
'The following code is to generate and save a csv file backup
Workbooks.Open Filename:=fPath & "DailyReport.csv"
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
Application.CutCopyMode = False
Application.DisplayAlerts = False
ActiveWorkbook.SaveAs Filename:=fName_Print, _
FileFormat:=xlCSV, Password:="", WriteResPassword:="", _
Application.DisplayAlerts = True
'***End CSV File Code***
PrintError: ' Error handler in event no printer is found
MsgBox "Print Error: Check your printer, network connections."
FileError: ' Error handler in event no file can be generated
MsgBox "File Saving Error: An error occured while saving the daily report file. Check your filename and path."