Code to create New Folder (if doesn't exist) and then Save Workbook to folder

Hello all,

I am a newbie, so please be kind. I have been trying to correct this code for 2 days, and must admit I need help. I'm sure it's something simple, but can't crack it.

I am using Excel 2007 and saving to a shared drive.

I'm attempting to create a new folder, based on specific information in the workbook. If the folder already exists, I just need the workbook saved.
The workbook also needs to be saved/named based on specific information in the workbook.

The current code I have is:

Sub SaveAs()

Dim evnfol, newfol, sfile As String

envfol = "\\MATTHEW-HP\Users\Matthew\Desktop\SCRATCH\Events\2013\"
newfol = Format(CStr(Range("a13").Text), "mm.dd.yyyy") & Range("a9").Value & Range("b9").Value
sfile = Format(CStr(Range("a13").Text), "mm.dd.yyyy") & Range("a9").Value & Range("b9").Value & Range("a11").Value

If Len(Dir(envfol & newfol, vbDirectory)) = "" Then
   MkDir newfol
End If


ActiveWorkbook.SaveAs Filename:="envfol & newfol & " \ " & sfile", FileFormat:=52, Password:="", WriteResPassword:="", ReadOnlyRecommended:=False, CreateBackup:=False
        
End Sub

Right now I'm receiving a error 13 type mismatch.
Earlier today I was receving a error 1004 Method SaveAs of Workbook failed

Thank you in advance for your assistance.
Jenn

I would at least change it to this:

Sub SaveAs()
 
    Dim evnfol, newfol, sfile As String
    envfol = "\\MATTHEW-HP\Users\Matthew\Desktop\SCRATCH\Events\2013\"
    newfol = Format(CStr(Range("A13").Text), "mm.dd.yyyy") & Range("A9").Value & Range("B9").Value
    sfile = Format(CStr(Range("A13").Text), "mm.dd.yyyy") & Range("A9").Value & Range("B9").Value & Range("A11").Value
    If Len(Dir(envfol & newfol, vbDirectory)) = 0 Then      '<==changed
        MkDir envfol & newfol                               '<==changed
    End If
     ActiveWorkbook.SaveAs Filename:=envfol & newfol & "\" & sfile & ".xlsm", FileFormat:=52, Password:="", _ 
               WriteResPassword:="", ReadOnlyRecommended:=False, CreateBackup:=False     '<==changed
End Sub

***cancelled***

Try using filesystemobject instead of Dir:

Option Explicit

Sub CreateFileFolder()

  Dim evnfol$, newfol$, sfile$, fso As Object

  ' Get path of folder where the project will reside
    Set fso = CreateObject("Scripting.FileSystemObject")
    
    envfol = "\\MATTHEW-HP\Users\Matthew\Desktop\SCRATCH\Events\2013\"
    newfol = Format(CStr(Range("a13").Text), "mm.dd.yyyy") & Range("a9").Value & Range("b9").Value
    sfile = Format(CStr(Range("a13").Text), "mm.dd.yyyy") & Range("a9").Value & Range("b9").Value & Range("a11").Value  ' Alternate path
    
    fPath = envfol & newfol
    If Not fso.FolderExists(fPath) Then fso.CreateFolder (fPath)
    
    ActiveWorkbook.SaveAs Filename:="envfol & newfol & " \ " & sfile", FileFormat:=52

End Sub

Also I should note that your declarations are a bit off in that you have to declare each variable by itself or else Excel will consider it a variant. So in your example, evnfol and newfol are variants, while sfile is the only one being declared as a string. This syntax is different from other programming language where you can create group declarations.

Hope this helps.

abousetta

Try this modified code:

Option Explicit

Sub CreateFileFolder()

  Dim envfol$, newfol$, sfile$, fPath$, fso As Object, wSh As Object, myDesktop$
  
  ' Get path of folder where the project will reside (on Desktop)
    Set wSh = CreateObject("Wscript.Shell")
    myDesktop = wSh.SpecialFolders("Desktop")
    envfol = myDesktop & "\SCRATCH\Events\2013\"
    newfol = Format(Range("a13").Text, "mm.dd.yyyy") & Range("a9").Value & Range("b9").Value
    sfile = Format(Range("a13").Text, "mm.dd.yyyy") & Range("a9").Value & Range("b9").Value & Range("a11").Value  ' Alternate path
    fPath = envfol & newfol & "\"
    Set fso = CreateObject("Scripting.FileSystemObject")
    If Not fso.FolderExists(fPath) Then fso.CreateFolder (fPath)
    
  ' Save the workbook
    ActiveWorkbook.SaveAs Filename:=fPath & sfile & ".xlsm", FileFormat:=52

End Sub

It will fail if you don't have a folder called "SCRATCH\Events\2013\" residing on your desktop because it won't make several levels of folders but the code can be amended if needed.

Let me know if this works for you.

abousetta

Hi Jenn,

OK, let's test step by step...

Option Explicit

Sub CreateFileFolder()

  Dim envfol$, newfol$, sfile$, fPath$, fso As Object, wSh As Object, myDesktop$
  
  ' Get path of folder where the project will reside (on Desktop)
    envfol = "\\MATTHEW-HP\Users\Matthew\Desktop\SCRATCH\Events\2013\"
    newfol = Format(Range("a13").Text, "mm.dd.yyyy") & Range("a9").Value & Range("b9").Value
    sfile = Format(Range("a13").Text, "mm.dd.yyyy") & Range("a9").Value & Range("b9").Value & Range("a11").Value  ' Alternate path
    fPath = envfol & newfol & "\"
    Msgbox fPath
    Set fso = CreateObject("Scripting.FileSystemObject")
    If Not fso.FolderExists(fPath) Then fso.CreateFolder (fPath)
    
  ' Save the workbook
    ActiveWorkbook.SaveAs Filename:=fPath & sfile & ".xlsm", FileFormat:=52

End Sub

Does this work? and is the path in the MessageBox correct?

abousetta