How to make/name new folder & subfolders if none exist.

[naoaja]

I have copied the below from another list, but have been unable to modify it so that it works.

What I am doing is from a form have a command button that opens a folder and then subfolder, based on name, etc. and if those folders don't exist to create them automatically and then open them.

In a module (MakeFolder)I put the following:
-----------------------------------------------------

Public Function MakeFolder(FolderPath As String)
Dim astrFolder As Variant
Dim intFolder As Integer

'make sure Folderpath does not end with \
If Right$(FolderPath, 1) = "\" Then
FolderPath = Left$(FolderPath, Len(FolderPath) - 1)
End If
'make sure folder path exists
If Len(Dir(FolderPath, vbDirectory)) = 0 Then
astrFolder = Split(FolderPath, "\")
FolderPath = astrFolder(0)
For intFolder = 1 To UBound(astrFolder)
FolderPath = FolderPath & "\" & astrFolder(intFolder)
If Len(Dir(FolderPath, vbDirectory)) = 0 Then
MkDir FolderPath
End If
Next
FolderPath = FolderPath & "\"
End If
End Function

----------------------------------------------------
Then on a command button I have:
Dim astrFolder As Variant
Dim intFolder As Integer
Dim cSource As String


cSource = "C:\PetFolder" & Me.LastName & ", " & Me.FirstName & " " & Me.PetID & " " & Me.DOB

'see if pets folder exists
If Len(Dir(cSource, vbDirectory)) = 0 Then
if not then build complete folder path as necessary
Call MakeFolder(cSource)
'if it did not exist then we need to make their subfolders also
Call MakeFolder(cSource & "\XRay")
Call MakeFolder(cSource & "\Lab")
Call MakeFolder(cSource & "\Food")
End If

Shell "explorer.exe" & cSource, vbMaximizedFocus
Exit Sub

End Sub

----------------------------------------------


But when I try to run this, it brings up an error message "expected variable or proceedure, not module"

I am not sure how to get this to work. I have not done a lot with modules.

Appreciate input.

thanks

 

[JerryKlmns]

naoaja

Rename your module name as it is the same with your function
name and change this
Dim astrFolder As Variant
to
Dim astrFolder() As String

BTW, is this a valid folder name
Me.LastName=Doe
Me.FirstName=John
Me.PetID=12586
Me.DOB=xyz
C:\PetFolderDoe, Gohn 12586 xyz

 

[naoaja]

Thanks for the response.

I changed the name of the module and changed
Dim astrFolder() As String

Now I get an error message "Expected array" and it highlights below.
----------------------------
If Len(Dir(FolderPath, vbDirectory)) = 0 Then
astrFolder = Split(FolderPath, "\")
[COLOR=red yellow]FolderPath = astrFolder(0)[/color]
For intFolder = 1 To UBound(astrFolder)
FolderPath = FolderPath & "\" & astrFolder(intFolder)
If Len(Dir(FolderPath, vbDirectory)) = 0 Then
MkDir FolderPath
End If
-------------------------------


Other suggestions?

thanks

 

[naoaja]

If I change it back to
Dim astrFolder As Variant


Then I get an error message of "Path not found" and the below line is highlighted.
----------------------------
If Len(Dir(FolderPath, vbDirectory)) = 0 Then
astrFolder = Split(FolderPath, "\")
FolderPath = astrFolder(0)
For intFolder = 1 To UBound(astrFolder)
FolderPath = FolderPath & "\" & astrFolder(intFolder)
If Len(Dir(FolderPath, vbDirectory)) = 0 Then
[COLOR=red yellow]MkDir FolderPath[/color]
End If
-------------------------------

Thanks for looking!

 

[PHV]

You simplify your function, perhaps like this:

Sub MakeFolder(FolderPath As String)
On Error Resume Next
Dim a, t As String, i As Integer
a = Split(FolderPath, "\")
t = a(0)
For i = 1 To UBound(a)
  t = t & "\" & a(i)
  MkDir t
Next
End Sub

Hope This Helps, PH.
Want to get great answers to your Tek-Tips questions? Have a look at FAQ219-2884 or FAQ181-2886

 

[naoaja]

Thanks for the help! If I put your code above in the module (I'm assuming that I would take out the Sub and End Sub lines since it is in a module?)
Then when I hit the command button it now gives me an error "File not found" and highlights the code below:


[COLOR=red yellow]Shell "explorer.exe" & cSource,vbMaximizedFocus[/color].

Further suggestions? I really do appreciate the help!

thanx again