How To Create a Daily Task Workbooks For Current Month using Excel VBA Macro

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