Forcing folder creation

[thekamel]

Hello everyone,

I am using a script that will save a file to a specific folder based of a couple of cells. If the folder doesn't exist, the command fails. I cannot figure out how to get it to create the folder if it isn't there. Here is what I am using now:

Sub File_Save()

Dim Path1 As String
Dim Path2 As String
Dim myfilename As String
Dim fpathname As String

Path1 = Range("K278")
Path2 = Range("K279")
myfilename = Range("K280")
fpathname = Path1 & "\" & Path2 & myfilename & ".xlsm"

MsgBox "You are trying to save the file to:" & vbCrLf & fpathname
ActiveWorkbook.SaveAs Filename:=fpathname, FileFormat:=xlOpenXMLWorkbookMacroEnabled

End Sub

Any help is greatly appreciated!

Thank you,
Kamel

 

[johnnyL]

Untested, but try this:

Sub File_Save()
'
    Dim Path1       As String, Path2        As String
    Dim fpathname   As String, myfilename   As String
'
    Path1 = Range("K278")
    Path2 = Range("K279")
    myfilename = Range("K280")
'
    If Len(Dir(Path1)) = 0 Then MkDir Path1
    If Len(Dir(Path2)) = 0 Then MkDir Path2
'
    fpathname = Path1 & "\" & Path2 & myfilename & ".xlsm"
'
    MsgBox "You are trying to save the file to:" & vbCrLf & fpathname
'
    ActiveWorkbook.SaveAs Filename:=fpathname, FileFormat:=xlOpenXMLWorkbookMacroEnabled
End Sub

 

[Marc L]

Hello,​

​

or just using MakeSureDirectoryPathExists like in this thread :​

Macro to save and separate multiple worksheets as individual files in .csv format

Please I have multiple worksheets in a workbook saved in xlsx. The task I need the vba for, is to separate these worksheets into individual workbooks in csv format with their names corresponding to the names as used in the worksheets. It would also be great if all separated sheets could all be...

www.mrexcel.com

 

[Marc L]

A VBA demonstration to paste to the top of the module (for Excel versions prior to 2010 version remove PtrSafe statement) :​

Private Declare PtrSafe Function MakeSureDirectoryPathExists Lib "imagehlp.dll" (ByVal DirPath$) As Boolean

Sub Demo1()
    Dim F$
        F = Join$([TRANSPOSE(K278:K280)], "\")
        If MakeSureDirectoryPathExists(F) Then ActiveWorkbook.SaveAs F, 52 Else Beep
End Sub