Excel VBA Macro to Create a Daily Task Workbooks for Current Month
'This Macro Create Folder For the Curret Month(Eg: Noveber_2012)
'This Macro Creates Workbooks In the Current Month Folder(Eg: 01-Nov2012).
'This Macro Creates 30/31 Workbooks Based on No.of Days in a Month
'Each Workbook Name Begins From 1st Day of Month to Last Day(Eg:01-Nov-2012......... 30-Nov-2012)
'Note:
We can use this Macro once in a Month to create the required Workbooks for that Month.
Sub DayTaskBooks4Month()
Dim D As String
Dim M As String
Dim MN As Strin
Dim Y As String
Dim P As String
Dim FSO As Object
Dim MyPath As String
Dim B As String
Dim A As Integer
Application.DisplayAlerts = False
D = Day(DateSerial(Year(Date), MONTH(Date) + 1, 1) - 1)
'Counts No.of Days In a Month
M = MONTH(Date)
MN = MonthName(M)
Y = Year(Date)
P = "C:\Documents and Settings\Administrator\My Documents\"
MyPath = P & MN & "_" & Y
Set FSO = CreateObject("Scripting.FileSystemObject")
If FSO.FolderExists(MyPath) = True Then
MsgBox MyPath & " Folder Already Exists In Given Path", vbOKCancel, "Folder Already Exists"
Exit Sub
End If
MkDir P & MN & "_" & Y
For A = 1 To D
B = A & " - " & Left(MN, 3) & " - " & Y
Workbooks.Add.SaveAs P & MN & "_" & Y & "\" & B & ".Xlsx"
Workbooks(B).Save
Workbooks(B).Close
Next A
End Sub
Thanks,TAMATAM
'This Macro Create Folder For the Curret Month(Eg: Noveber_2012)
'This Macro Creates Workbooks In the Current Month Folder(Eg: 01-Nov2012).
'This Macro Creates 30/31 Workbooks Based on No.of Days in a Month
'Each Workbook Name Begins From 1st Day of Month to Last Day(Eg:01-Nov-2012......... 30-Nov-2012)
'Note:
We can use this Macro once in a Month to create the required Workbooks for that Month.
Sub DayTaskBooks4Month()
Dim D As String
Dim M As String
Dim MN As Strin
Dim Y As String
Dim P As String
Dim FSO As Object
Dim MyPath As String
Dim B As String
Dim A As Integer
Application.DisplayAlerts = False
D = Day(DateSerial(Year(Date), MONTH(Date) + 1, 1) - 1)
'Counts No.of Days In a Month
M = MONTH(Date)
MN = MonthName(M)
Y = Year(Date)
P = "C:\Documents and Settings\Administrator\My Documents\"
MyPath = P & MN & "_" & Y
Set FSO = CreateObject("Scripting.FileSystemObject")
If FSO.FolderExists(MyPath) = True Then
MsgBox MyPath & " Folder Already Exists In Given Path", vbOKCancel, "Folder Already Exists"
Exit Sub
End If
MkDir P & MN & "_" & Y
For A = 1 To D
B = A & " - " & Left(MN, 3) & " - " & Y
Workbooks.Add.SaveAs P & MN & "_" & Y & "\" & B & ".Xlsx"
Workbooks(B).Save
Workbooks(B).Close
Next A
End Sub
Thanks,TAMATAM
No comments:
Post a Comment
Hi User, Thank You for visiting My Blog. Please post your genuine Feedback or comments only related to this Blog Posts. Please do not post any Spam comments or Advertising kind of comments which will be Ignored.