Making a directory if one doesn't exist

[bigjim]

I am using excel 2003. The user enters a path name where he wants to save a
file. I need this code to check to see if the directory they enter exists
and if not I want to make the directory for them. This is the code I'm
using, but I get the error path not found when the program tries to save it.

Worksheets("ticket").Activate

strappend = ActiveSheet.Range("j8").Value
strpath = ActiveSheet.Range("b200").Value
str3 = ActiveSheet.Range("c8").Value



MsgBox strpath

Rem making directory if it doesn't exist
If Dir(strpath, vbDirectory) = "" Then MkDir strpath

fsavename = strpath & strappend & str3 & ".xls"

ThisWorkbook.SaveAs Filename:=fsavename

I am using the msgbox to make sure the path entered is getting assigned to
strpath and it is. J8 and C8 are the file name. In his case strpath =
c:\2008\Jun\ J8 = C005482 and C8 = Encana. I checked and the folder
c:\2008\jun\ was not created.

Any help would be appreciated.

Jim

 

[Dave Peterson]

I'd just try to make the directory and ignore the error if it's already there.

on error resume next
mkdir strpath
on error goto 0

This assumes that the strpath is one level deep.

If you have to make multiple levels:

on error resume next
mkdir "C:\test"
mkdir "C:\test\sub1"
mkdir "C:\test\sub1\sub2"
.....

 

[bigjim]

That explains it. I didn't know it wouldn't go more than one layer at a
time. That presents a problem. I think I'll just check if the directory
exists and if it doesn't use a msgbox to alert the uset to make the directory
theirself and end the program. Thanks for your help.

Jim

 

[Dave Peterson]

Or you could use a Windows API.

This sample loops through a range of cells and creates folders by the values in
those cells.

(saved from a previous post)

You may want to test to see if the folder exists after the attempt. (If you use
a mapped drive that doesn't exist (like x, you may want to see a warning:

Option Explicit
Declare Function MakePath Lib "imagehlp.dll" Alias _
"MakeSureDirectoryPathExists" (ByVal lpPath As String) As Long

Sub testme()
Dim myCell As Range
Dim myRng As Range
Dim myPath As String
Dim res As Long

With Worksheets("Sheet1")
Set myRng = .Range("a1", .Cells(.Rows.Count, "A").End(xlUp))
End With

For Each myCell In myRng.Cells
myPath = myCell.Value
If Right(myPath, 1) <> "\" Then
myPath = myPath & "\"
End If
res = MakePath(myPath)
If res = 1 Then
'ok
Else
MsgBox myPath & " does not exist!"
End If
Next myCell

End Sub

 

[joel]

Dave: Is ther a reason you didn't use

object.FolderExists(folderspec)

?????

 

[Dave Peterson]

If all I want to do is test to see if the directory exists, I'd use something
like:

Dim teststr as string
teststr = ""
on error resume next
teststr = dir("somepathhere\" & "nul")
on error goto 0
if teststr = "" then
'not there
else
'is there
end if

Or even use dir() with vbdirectory...

I don't see a real good need to create another object when I can stay in native
VBA.

Besides, after I get the results from FSO.folderexists, I still may need to
create the folder.

So if I know the structure, why not just use mkdir and ignore any errors.

And if I don't want know the structure (and don't want to parse it), I'd use the
API (if I could find it!).

Dave: Is ther a reason you didn't use

object.FolderExists(folderspec)

?????

 

[bigjim]

You just zoomed over my head I think. However, you have been a big help.
The only way I see to make this work, is just create my own error message and
make the user create the directory. It seems that the only other way is to
have them enter each part of the directory separate. Since most of the users
of this program tend to get confused easily (just like me), I think it would
be easier to just give them the error, make them create the directory, then
start the program over.
Thanks for the help, both of you. I really apprecite it.

Jim

 

[Tim Zych]

Here's a function which should do what you want.

Paste it into a module and then your users should be able to create
directories as easily as you envision. This function creates directories and
subdirectories, and returns True/False letting you know if there were any
problems.

Here is how I imagine you would use it.

Sub TestCreateDir()
Dim strDir As String
strDir = InputBox("Enter a directory to create.")
'strDir = "D:\Folder\SubFolder\SubSubFolder"
CreateDir (strDir)
Shell "explorer.exe " & strDir, vbMaximizedFocus
' Or do whatever else you need to with the newly-created directory
End Sub

' Creates a fully-extended directory (w/ sub-directories) if they don't
already exist.
' Returns True if directory already exists or was created successfully,
False if there is an error.
' --------------------------------------------------------------
' bCreated = CreateDir("D:\Data\Some New Dir")
' or
' CreateDir("D:\Data\Some New Dir\") ' Trailing slash doesn't matter
' or
' CreateDir("\\NtwrkShare\Some Dir") ' UNC Ok too
' --------------------------------------------------------------
Function CreateDir(ByVal strDir As String) As Boolean

Dim strDirItems() As String, strDirAdj As String, i As Integer,
strDirItem As String

On Error GoTo ErrHandler

If Left(strDir, 3) Like "?:\" Then
strDirAdj = strDir
ElseIf Left(strDir, 2) = "\\" Then
strDirAdj = Right(strDir, Len(strDir) - 2)
Else
CreateDir = False
Exit Function
End If

If Dir(strDir, vbDirectory) <> "" And Len(strDir) > 0 Then
' Dir already exists.
CreateDir = True
Exit Function
End If

' Remove rightmost slash if it's there.
If Right(strDirAdj, 1) = "\" Then
strDirAdj = Left(strDirAdj, Len(strDirAdj) - 1)
End If

strDirItems() = Split(strDirAdj, "\")

' Does this looke like a drive-mapped directory name?
If Left(strDirItems(LBound(strDirItems)), 2) Like "?:" Then
' If so, use the first item in the array as-is.
strDirItem = strDirItems(LBound(strDirItems))
Else
' If not, reform the first item in the array as a UNC.
strDirItem = "\\" & strDirItems(LBound(strDirItems))
End If

' Loop through the remaining items in the directory array and create
them if they don't already exist.
For i = LBound(strDirItems) + 1 To UBound(strDirItems)
strDirItem = strDirItem & "\" & strDirItems(i)
' Create the folder if it doesn't exist.
If Dir(strDirItem, vbDirectory) = "" Then
MkDir strDirItem
End If
Next i

CreateDir = True

Exit Function

ErrHandler:
CreateDir = False
End Function


--
Regards,
Tim Zych
http://www.higherdata.com
Workbook Compare - Excel data comparison utility

You just zoomed over my head I think. However, you have been a big help.
The only way I see to make this work, is just create my own error message
and
make the user create the directory. It seems that the only other way is
to
have them enter each part of the directory separate. Since most of the
users
of this program tend to get confused easily (just like me), I think it
would
be easier to just give them the error, make them create the directory,
then
start the program over.
Thanks for the help, both of you. I really apprecite it.

Jim

 

[Dave Peterson]

That's what the API suggestion did.

Here's a more straight forward example:

Option Explicit
Declare Function MakePath Lib "imagehlp.dll" Alias _
"MakeSureDirectoryPathExists" (ByVal lpPath As String) As Long

Sub testme()

Dim myPath As String
Dim res As Long

myPath = "C:\my folder\test1\test2\test3"
If Right(myPath, 1) <> "\" Then
myPath = myPath & "\"
End If
res = MakePath(myPath)
If res = 1 Then
'ok
Else
MsgBox myPath & " was not created"
End If

End Sub


It checks to see if it was successful to make sure that the path was legal--The
drive exists, the characters in the path string are legal, ...

You just zoomed over my head I think. However, you have been a big help.
The only way I see to make this work, is just create my own error message and
make the user create the directory. It seems that the only other way is to
have them enter each part of the directory separate. Since most of the users
of this program tend to get confused easily (just like me), I think it would
be easier to just give them the error, make them create the directory, then
start the program over.
Thanks for the help, both of you. I really apprecite it.

Jim

 

[Patrick Molloy]

ine could use the FileSystemObject and a UDF to show on the worksheet
whether its a good folder or not.

In the Developer environment, under the Tools menu, select References
scroll down until you see Microsoft Scripting Runtime....check the box and
click OK

then in a code module, add the UDF:

Function FolderExists(sText As String) As Boolean
With New FileSystemObject
FolderExists = .FolderExists(sText)
End WithEnd Function
End Function


in a scpreadsheet, type some file path in any cell, say B5, then in the
adjascent cell
=FolderExists(B5)
it will show TRUE or False appropriately

 

[rpw]

Hello Patrick,

Just a quick couple of questions related to your solution: Does the
Microsoft Scripting Runtime box need to be checked on each separate machine
that the macro runs on? And if so, then is there a way to bypass that like
check the box via VBA?

 

[Patrick Molloy]

once the reference is selected, this remains so until deselected. so long as
the dll exists on each users' pc, there's no need to do anything further

 

[rpw]

Thank you for the answer!
--
rpw

once the reference is selected, this remains so until deselected. so long as
the dll exists on each users' pc, there's no need to do anything further