Creating a folder automatically

  • Thread starter Thread starter Hari
  • Start date Start date
H

Hari

Hi,

2 weeks back I started with VB by copying codes from this newsgroup and
trying out to make some sense of VB.

I came across a post a few hours back from RPIJG (Msgbox question...) in
which the person is automatically saving a file with a filename based on
some predetermined conditions.

Luckily I was in need of this and for my situation it works perfectly fine
based on sllight modifications.

My query is is it possible to create a folder if the folder doesnt exist.

For ex. My code is :-

Sub Writingfilenames()

Dim chosenname As String
Dim todaysformatteddate As String
Windows("ADSS-01.txt").Activate
foldername = Sheets("ADSS-01").Cells(3, 14)
filename = Sheets("ADSS-01").Cells(3, 4)
ActiveWorkbook.SaveAs Filename:="C:\CCAPPS\ttlview\TMP\" & foldername & "\"
& filename, FileFormat:=xlNormal

End Sub

In this I have a particular file by the name ADSS-01 --> A text (tab
limited) file.This file comes by exporting data from a program ( using its
export to spreadsheet option)

I want to rename this file based on what is there in the cell D3 hence the
varaible chosen name picks the value from D3.

Also I want to save the file in a particular folder whose name will be
today's date. That is if todays' date is "09-Jun-04" then I want to save it
in the folder
09-Jun-04. For this in the cell N2 of ADSS-01 I have used a formula
Text(today(),"dd-mmm-yy") and Im doing a paste special of this in
the cell N2. So, the foldername is picked up from cell N#.

My problem is it could happen that the folder name specified above may not
exist.

I was thinking whther the above code could be modified such that if folder
name doesnt exist then a folder ( whose name will be determined by the value
in
Sheets("ADSS-01").Cells(3, 14) ) could be created automatically.

Please tell me if the same is possible.

Regards,
Hari
India
 
Sub Writingfilenames()

Dim chosenname As String
Dim todaysformatteddate As String
Windows("ADSS-01.txt").Activate
foldername = Sheets("ADSS-01").Cells(3, 14).Text
If Not FolderExists(foldername) Then
MkDir foldername
End If

filename = Sheets("ADSS-01").Cells(3, 4).Text
ActiveWorkbook.SaveAs Filename:="C:\CCAPPS\ttlview\TMP\" & foldername &
"\" & filename, FileFormat:=xlNormal

End Sub

'-----------------------------------------------------------------
Function FolderExists(Folder) As Boolean
'-----------------------------------------------------------------
Dim sFolder As String
On Error Resume Next
sFolder = Dir(Folder, vbDirectory)
If sFolder <> "" Then
If (GetAttr(sFolder) And vbDirectory) = vbDirectory Then
FolderExists = True
End If
End If
End Function


--

HTH

Bob Phillips
... looking out across Poole Harbour to the Purbecks
(remove nothere from the email address if mailing direct)
 
Bob - Didn't bother to show your function, but the below is bombing on me at
or on the last line; Why?
TIA,
JMay


Sub Writingfilenames()
Dim foldername As String
Dim todaysformatteddate As String
'Windows("C:\WINDOWS\Desktop\Temp Excel
Formulas\Create_FolderDirectory_If_Such_Does_Not_Exist.xls").Activate
foldername = Sheets("ADSS-01").Cells(3, 4).Text
If Not FolderExists(foldername) Then MkDir foldername
Filename = Sheets("ADSS-01").Cells(3, 4).Text
<< ActiveWorkbook.SaveAs Filename:="C:\My Documents\" & foldername & "\"
& Filename >> Bombing Here
End Sub
 
Hi Jmay

Its my mistake. ( Though I havent been able to try Bob's code as I dont
understand some parts ...)

While writing code on the NG I wrote as :-
Dim chosenname As String
Dim todaysformatteddate As String

But to make it clear I changed in the value setting to :-
foldername = Sheets("ADSS-01").Cells(3, 14)
filename = Sheets("ADSS-01").Cells(3, 4)

So probably the bombing could be avoided if the declaration is changed to
Dim foldername As String
Dim filename As String

Please write back on whether it works now..

Regrads,
Hari
India
 
Thanks Hari:
Changed things as you suggested.
even changed prob line to:

ActiveWorkbook.SaveAs Filename:="C:\My Documents\" & foldername & "\" &
Filename & ".xls"

Still no cigar!!!
 
JMay,

I think the reason that it fails is because I forgot to include the path
prefix in the function call. This should work

Sub Writingfilenames()

Dim chosenname As String
Dim todaysformatteddate As String
Windows("ADSS-01.txt").Activate
foldername = ("C:\CCAPPS\ttlview\TMP\" & Sheets("ADSS-01").Cells(3,
14).Text
If Not FolderExistsfoldername) Then
MkDir foldername
End If

filename = Sheets("ADSS-01").Cells(3, 4).Text
ActiveWorkbook.SaveAs Filename:=foldername & "\" & filename,
FileFormat:=xlNormal

End Sub

Although it does assume that this folder "C:\CCAPPS\ttlview\TMP\" exists,
else it will still fail. It might be necessary to test each level, and
create those that don't exist. Of course that could be done recursively in
the folderexists code<g>.

--

HTH

Bob Phillips
... looking out across Poole Harbour to the Purbecks
(remove nothere from the email address if mailing direct)
 
Hi Bob,

Im sorry, Im having problem in understanding ur code.

This time instead of picking the name of the folder from "ADSS-01.txt" sheet
Im picking the name from my personla macro folder ( Actually the name of the
folder is Date in text form -- dd-mmm-yy).

I copied ur code and pasted in to VB editor as it is ( Im pasting the same
code below also ) and Im getting a "Compile error . Sub or function not
defined" and the folderexists after the "If not" statement is getting
highlighted.


( Also, Im not able to understand the second part of ur code starting from
Dim sfolder as string. Please tell me what this does)

Sub creatingfoldername()

Dim foldername As String
Dim filename As String
Windows("personal.xls").Activate
foldername = ("C:\CCAPPS\ttlview\TMP\" & Sheets("sheet1").Cells(7,
1).Text)
If Not FolderExists(foldername) Then
MkDir foldername
MsgBox "A new folder by the name" & foldername & "created"
End If
Windows("ADSS-01.txt").Activate
filename = Sheets("ADSS-01").Cells(3, 4).Text
ActiveWorkbook.SaveAs filename:=foldername & "\" & filename,
FileFormat:=xlNormal

End Sub

Dim sFolder As String
On Error Resume Next
sFolder = Dir(Folder, vbDirectory)
If sFolder <> "" Then
If (GetAttr(sFolder) And vbDirectory) = vbDirectory Then
FolderExists = True
End If
End If
End Function



Regards,
Hari
India
 
Hari,

You have missed the Function declaration. Try this version of your code

Sub creatingfoldername()

Dim foldername As String
Dim filename As String
Windows("personal.xls").Activate
foldername = ("C:\CCAPPS\ttlview\TMP\" & Sheets("sheet1").Cells(7,
1).Text)
If Not FolderExists(foldername) Then
MkDir foldername
MsgBox "A new folder by the name" & foldername & "created"
End If
Windows("ADSS-01.txt").Activate
filename = Sheets("ADSS-01").Cells(3, 4).Text
ActiveWorkbook.SaveAs filename:=foldername & "\" & filename,
FileFormat:=xlNormal

End Sub

'-----------------------------------------------------------------
Function FolderExists(Folder) As Boolean
'-----------------------------------------------------------------
Dim sFolder As String
On Error Resume Next
sFolder = Dir(Folder, vbDirectory)
If sFolder <> "" Then
If (GetAttr(sFolder) And vbDirectory) = vbDirectory Then
FolderExists = True
End If
End If
End Function


--

HTH

Bob Phillips
... looking out across Poole Harbour to the Purbecks
(remove nothere from the email address if mailing direct)
 
Hi Bob,

Thanx a ton for helping me out. Its working perfectly now.

Wanted to trouble u with one more request.

Im not able to understand what the second function folderexists does. Rather
how does the VB check that the folderexists or not.

In VB help I typed Getattr and vbdirectory to see what they mean or what
their function is but not able to understand properly.
Please tell me if there is a website from where I may understand what these
2 stand for.

Regards,
Hari
India
 
Back
Top