PDA

View Full Version : Schedule Event on First Business Day of Month



ajrob
02-04-2009, 09:50 PM
I have three questions ... help on any of them would be most appreciated.

I wrote the following -- very simple code that saves a file named 0902 2009 Open Provisioning - TBM.xls to a network drive:

Application.Run "'Ladder Current.xls'!Open_Provisioning"
Sheets("OpenProv").Select
Sheets("OpenProv").Copy
ActiveWorkbook.SaveAs Filename:= _
"S:\temp\ARobinson\0902 2009 Open Provisioning - TBM.xls", FileFormat:= _
xlNormal, Password:="", WriteResPassword:="", ReadOnlyRecommended:=False _
, CreateBackup:=False
ActiveWindow.Close

The first thing I'd like to do be able to do is to run this on scheduled event occuring on the first business day of the new month. Is there such a feature? All I can find is OnTime -- which limits me to a time of day.

The second thing I'd like to do is to name the file based on the date. So, in Feb it's 0902 2009 Open Provisioning - TBM.xls, and next month it would be 0903 2009 Open Provisioning - TBM.xls, etc. Possible?

Lastly, you'll note that I call a macro called "Open Provisioning". In it, I have two Message boxes:

' Copies info contained in User-defined Ladder, then formats contents in the "OpenProv" worksheet.
Dim IB As String
Dim IBLad As String

While IB = ""
IB = InputBox("Enter a year date in this format: " & Chr(34) & "YYYY" & Chr(34), "Sheet Name selection")
IBLad = IB & " Ladder"
Wend

On Error Resume Next

and,

' Filter list according to User-specified input.
Dim Pkgr As String
iRow = 4

Pkgr = InputBox("Enter a Packager source as either (All, Pkg, TBM, or PA:", "Packager Source")

Do Until iRow = 500
If Pkgr = "Pkg" Then
If Range("M" & iRow) <> "Pkg" And Range("M" & iRow) <> "MPU" Then
Range("B" & iRow & ":" & "AS" & iRow).Select
Selection.ClearContents
Range("AU" & iRow).Select
ActiveCell.FormulaR1C1 = 0
End If
ElseIf Pkgr = "TBM" Then
If Range("M" & iRow) <> "TBM" Then
Range("B" & iRow & ":" & "AS" & iRow).Select
Selection.ClearContents
Range("AU" & iRow).Select
ActiveCell.FormulaR1C1 = 0
End If
Else
Pkgr = "PA"
If Range("M" & iRow) <> "PA" Then
Range("B" & iRow & ":" & "AS" & iRow).Select
Selection.ClearContents
Range("AU" & iRow).Select
ActiveCell.FormulaR1C1 = 0
End If
End If
iRow = iRow + 1
Loop

All I'm wondering now is whether I can set responses to the Message boxes inside of a scheduled event. To be clearer, the code above is written around manual input. But if I want to run the code based on a scheduled time (first business day of the new month), is there a way to assign inputs to the Message boxes?

Thanks.

Bob Phillips
02-05-2009, 03:05 AM
Public Sub ScheduleJob()
Dim RunTime As Date
Dim LastDayOfMonth As Date

LastDayOfMonth = DateSerial(Year(Date), Month(Date) + 1, 0)
RunTime = Application.Run("ATPVBAEN.XLA!WORKDAY", LastDayOfMonth, 1)
Application.OnTime RunTime, "SaveFile"
End Sub

Public Sub SaveFile()
Const FILE_NAME As String = _
"S:\temp\ARobinson\0902 2009 Open Provisioning - TBM.xls"

Application.Run "'Ladder Current.xls'!Open_Provisioning"
Sheets("OpenProv").Select
Sheets("OpenProv").Copy
ActiveWorkbook.SaveAs _
Filename:=Replace(FILE_NAME, "<date>", Format(Date, "yymm")), _
FileFormat:=xlNormal
ActiveWindow.Close

End Sub