Create folders and save Workbook

[Siderman]

How can i make this code save new folder to "\\fileserver\Users\Public\Documents\Main Customer\New Folder Name"
and create 3 subfolders "Images","Work Orders","Lead Info"

Public Sub SaveOnDesktop()Dim strPath As String, strFile As String
'Build Path
strPath = Environ$("HOMEPATH") & Application.PathSeparator & "Desktop" & _
Application.PathSeparator & Range("A1").Value
'Make Folder
MkDir strPath
'Build File Name
strFile = strPath & Application.PathSeparator & Range("A1").Value
'Save Activeworkbook
ActiveWorkbook.SaveAs strFile, 52 '51 is for default
End Sub

the current code creates filepath,names workbook,saves workbook all onto users desk top
Any help would be greatly appreciated!!

 

[patel45]

Public Sub SaveOnDesktop()
Dim strPath As String, strFile As String
'Build Path
strPath = "\\fileserver\Users\Public\Documents\Main Customer\New Folder Name"
'Make Folder
MkDir strPath
'Build File Name
strFile = strPath & Application.PathSeparator & Range("A1").Value
'Save Activeworkbook
ActiveWorkbook.SaveAs strFile, 52 '51 is for default
End Sub

 

[Siderman]

Thanks patel45 that worked!
I tweeked to to name new folder based on cell value.
Now how do i make subfolders with specific names
I have tried different MkDir & createfolder ect.. with no luck.

 

[patel45]

you can create subfolders with
MkDir strPath & "\" & subfoldername

 

[Siderman]

This is how i put MkDir strPath & "\" & subfoldername into my code and it didnt work ?

Public Sub SaveOnDesktop()Dim strPath As String, strFile As String
'Build Path
strPath = "\\fileserver\Users\Public\Documents\Main Customer\Current Job's\" & Range("A1").Value
'Make Folder
MkDir strPath & "\" & subfoldername
'Build File Name
strFile = strPath & Application.PathSeparator & Range("A1").Value
'Save Activeworkbook
ActiveWorkbook.SaveAs strFile, 52 '51 is for default
End Sub

 

[patel45]

paste here a link to a samplefile