MACRO - Check/Create Folder Structure And Save

[MarkAn]

Hi

I had previously posted something about this but I am still having problems, I am a novice with Macros.

I have an Excel spreadsheet that I need to save via a Macro, however, I need it to be saved in a specific location, which is compiled in a Cell in Excel I.e. D5 - returning the following location and file name::

C:\Documents and Settings\Administrator\My Documents\Downloads\Tick Sheet\2012 October\Sherman.xls

I believe that I need to use Dir and MKDir to first check if the location exists, if it does then Excel can save the file, if it doesn't then Excel would need to build the folder structure and then save the file.

Can someone please please help me, I would be very grateful.

Thanks

 

[JLGWhiz]

This will tell if there is an existing directory.

Code:
Sub IsIt()
MyPath = "C:\Documents and Settings\Administrator\My Documents\Downloads\Tick Sheet\2012 October"
If Dir(MyPath, vbDirectory) <> "" Then
MsgBox "Dir is there"
Else
MsgBox "Not there"
End If
End Sub
Code:

 

[Darren Bartrup]

This should do the trick:

Sub SaveFile()

    Dim sDest As String
    Dim sFolder As String
    
    sDest = ThisWorkbook.Worksheets("Sheet1").Cells(5, 4) 'Grab the value from cell D5
    
    sFolder = Left(sDest, InStrRev(sDest, "\")) 'Get the folder name
    
    CreateFolder (sFolder) 'Create the folder if it doesn't already exist.
    ThisWorkbook.SaveAs sDest 'Save the file in the folder


End Sub


'// ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
'// Procedure : CreateFolder | Sub
'// Author    : DarkSprout
'// Purpose   : Will Recursively Build ADirectory Tree
'// ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
Sub CreateFolder(Folder)
On Error Resume Next
Dim objFSO As Object: Set objFSO = CreateObject("Scripting.FileSystemObject")
    If Folder <> "" Then
        If Not objFSO.FileExists(objFSO.GetParentFolderName(Folder)) Then
            Call CreateFolder(objFSO.GetParentFolderName(Folder))
        End If
        objFSO.CreateFolder (Folder)
    End If
End Sub

 

[MarkAn]

Darren Bartrup

I would like to thank you fella, as this is exactly what I was looking for.

Many many thanks