Function to Check for a SubFolder - Create, if it doesn't exist
.
.
.
Function MyCreateSubFolder(ByVal sPath As String, sSubFolder As String)
Dim oFile As Object, oFSO As Object, oFolder As Object
Dim bFoundSubFolder As Boolean
'Set the Boolean Default
bFoundSubFolder = False
'Set the objects required for File Review
Set oFSO = CreateObject("Scripting.FileSystemObject")
Set oFolder = oFSO.GetFolder(sPath)
'Loop through each of the Sub Folders in the Path requested
For Each oFile In oFolder.subfolders
'If the desired subfolder was found, change the boolean
If oFile.Name = sSubFolder Then bFoundSubFolder = True
Next
'If the sub folder was NOT found, Create it
If bFoundSubFolder = False Then MkDir sPath & "\" & sSubFolder
End Function
.
.
Function MyCreateSubFolder(ByVal sPath As String, sSubFolder As String)
Dim oFile As Object, oFSO As Object, oFolder As Object
Dim bFoundSubFolder As Boolean
'Set the Boolean Default
bFoundSubFolder = False
'Set the objects required for File Review
Set oFSO = CreateObject("Scripting.FileSystemObject")
Set oFolder = oFSO.GetFolder(sPath)
'Loop through each of the Sub Folders in the Path requested
For Each oFile In oFolder.subfolders
'If the desired subfolder was found, change the boolean
If oFile.Name = sSubFolder Then bFoundSubFolder = True
Next
'If the sub folder was NOT found, Create it
If bFoundSubFolder = False Then MkDir sPath & "\" & sSubFolder
End Function
Method for calling the function
There is probably a reason you are checking to see if a Sub-Folder exists.
This code will call the function, create the Sub-Folder if it DOESN'T exist, AND Save a file in the Sub-Folder created.
This code will call the function, create the Sub-Folder if it DOESN'T exist, AND Save a file in the Sub-Folder created.
Sub [call function example]
Sub MoveTabToNewBook_SaveInSubfolder()
Dim sThisWorkbook As String, sFilePath As String, sNewSubFolder As String, sFileName As String
sThisWorkbook = ActiveWorkbook.Name
sFilePath = ActiveWorkbook.Path
sNewSubFolder = "Archive Files"
sFileName = "Did_It_Work"
'Move the sheet to a new book: (Move - not Copy)
Sheets("Visual").Select
Sheets("Visual").Move
'Check to see if the Sub-Folder Exists (Create it if it doesn't)
Call MyCreateSubFolder(sFilePath, sNewSubFolder)
Debug.Print "The Archived files are here: " & sFilePath & "\" & sNewSubFolder
'Save the File (Standard Excel format)
ActiveWorkbook.SaveAs Filename:=sFilePath & "\" & sNewSubFolder & "\" & sFileName & ".xlsx", FileFormat:=xlOpenXMLWorkbook, CreateBackup:=False
'Close the new file that was saved
ActiveWindow.Close
'Return to the original workbook
Workbooks(sThisWorkbook).Activate
End Sub
Dim sThisWorkbook As String, sFilePath As String, sNewSubFolder As String, sFileName As String
sThisWorkbook = ActiveWorkbook.Name
sFilePath = ActiveWorkbook.Path
sNewSubFolder = "Archive Files"
sFileName = "Did_It_Work"
'Move the sheet to a new book: (Move - not Copy)
Sheets("Visual").Select
Sheets("Visual").Move
'Check to see if the Sub-Folder Exists (Create it if it doesn't)
Call MyCreateSubFolder(sFilePath, sNewSubFolder)
Debug.Print "The Archived files are here: " & sFilePath & "\" & sNewSubFolder
'Save the File (Standard Excel format)
ActiveWorkbook.SaveAs Filename:=sFilePath & "\" & sNewSubFolder & "\" & sFileName & ".xlsx", FileFormat:=xlOpenXMLWorkbook, CreateBackup:=False
'Close the new file that was saved
ActiveWindow.Close
'Return to the original workbook
Workbooks(sThisWorkbook).Activate
End Sub