Creating folders as per date.

  • Thread starter Thread starter Heera
  • Start date Start date
H

Heera

Hi All,

I have created a macro and it generates a file from the data base and
it saves it on a particular location.

Now my problem is I want to save the files in the folders as per day.
I want a macro which should create a folder as I have mentioned below
automatically.

Zone (Zone will be available in the database.)
Year (If folder for year is not available it should generate
it automatically.)
Month (If folder for Month is not available it should
generate it automatically.)
Day (If folder for Day is not available it should
generate it automatically.)

File name will be combination of two strings and the user name.

For Ex: One file is generated with the name of TRS-BU-Jack.Smit.xls
on 13-Aug-09.
The above mentioned file should get generated in the folder of \
\ShareDrive\South Zone\2009\Aug\13-Aug-09\TRS-BU-Jack.Smit.xls

Regards
Heera Chavan
 
Folder = "\ShareDrive\"
On Error Resume Next
Folder = Folder & Zone & Aplication.PathSeparator
MkDir Folder
Folder = Folde & Year(Date) & Aplication.PathSeparator
MkDir Folder
Folder = Folde & Format(Date, "dd-mmm-yy") & Aplication.PathSeparator
 
Try this code

Sub Savefile()

Set fs = CreateObject("Scripting.FileSystemObject")


'I put two double quotes in front of drive name
Folder = "\\ShareDrive\South Zone\"
'added for testing
Folder = "\\ssdnjusersrv1\jwarburg$\temp\"


FileDate = DateValue("13-Aug-09")
FileYear = Year(FileDate)
FileMonth = Format(FileDate, "MMM")
FileDay = Format(FileDate, "DD-MMM-YY")

'check if year folder exists
FName = Dir(Folder & FileYear, Attributes:=vbDirectory)
If FName = "" Then
'make new folder
Set YearFolder = fs.getfolder(Folder)
YearFolder.subfolders.Add FileYear
End If
'check if month folder exists
MonthFolderName = Folder & FileYear & "\" & FileMonth
FName = Dir(MonthFolderName, Attributes:=vbDirectory)
If FName = "" Then
Set MonthFolder = fs.getfolder(Folder & FileYear)
'make new folder
MonthFolder.subfolders.Add FileMonth
End If

'make new workbook and save
FName = "TRS-BU-Jack.Smit.xls"
Set bk = Workbooks.Add
bk.SaveAs Filename:=MonthFolderName & "\" & FName


End Sub
 
an another way to do it !
'----------------------------------
Sub test()
Dim Pathway As String, Commande As String
Pathway = "\ShareDrive\" & zone & _
"\" & Year(Date) & "\" & Month(Date) & _
"\" & Format(Date, "dd-mmm-yy")
Commande = Environ("comspec") & " /c mkdir " & Pathway
Shell Commande, 0
End Sub
'----------------------------------




"Heera" <[email protected]> a écrit dans le message de groupe de discussion :
(e-mail address removed)...
Hi All,

I have created a macro and it generates a file from the data base and
it saves it on a particular location.

Now my problem is I want to save the files in the folders as per day.
I want a macro which should create a folder as I have mentioned below
automatically.

Zone (Zone will be available in the database.)
Year (If folder for year is not available it should generate
it automatically.)
Month (If folder for Month is not available it should
generate it automatically.)
Day (If folder for Day is not available it should
generate it automatically.)

File name will be combination of two strings and the user name.

For Ex: One file is generated with the name of TRS-BU-Jack.Smit.xls
on 13-Aug-09.
The above mentioned file should get generated in the folder of \
\ShareDrive\South Zone\2009\Aug\13-Aug-09\TRS-BU-Jack.Smit.xls

Regards
Heera Chavan
 
Back
Top