Function that will check if there is already a folder by that name-CodePudding

I'm trying to create a save function that will check if there is already a folder by the name specified in Range "G3" and if there is, it will just save the file. If there isn't it will create a new folder by that name and save the file.

Sub ExportAsCSV()

Dim MyFileName As String
Dim CurrentWB As Workbook, TempWB As Workbook
Dim sFilename As String
Const csPath As String = "C:\Users\gald\Desktop\Vintage - Gal\Hourly"

sFilename = Range("G2")
Set CurrentWB = ActiveWorkbook
ActiveWorkbook.ActiveSheet.UsedRange.Copy

Set TempWB = Application.Workbooks.Add(1)
With TempWB.Sheets(1).Range("A1")
  .PasteSpecial xlPasteValues
  .PasteSpecial xlPasteFormats
End With

Rows("1:6").Select
   Selection.Delete Shift:=xlUp

With Range("J2:W200")
    .NumberFormat = "General"
    .Value = .Value
End With

MyFileName = csPath & "\" & Left(sFilename, Len(sFilename)) & ".csv"
 
Application.DisplayAlerts = False
TempWB.SaveAs Filename:=MyFileName, FileFormat:=xlCSV, CreateBackup:=False, Local:=True
TempWB.Close SaveChanges:=False
Application.DisplayAlerts = True

End Sub

Thanks for the help = )

CodePudding user response：

You can use the os module

import os

# create the complete path
saving_path = "C\\user\\example_folder
if not os.path.exists(saving_path):
    os.makedirs(saving_path)

CodePudding user response：

Use the Api (Declare it in a module)

Public Declare PtrSafe Function MakeSureDirectoryPathExists Lib "imagehlp.dll" (ByVal lpPath As String) As Long

Call it like

MakeSureDirectoryPathExists(YourFolder) This will create the folder if not exists.

CodePudding user response：

I created a helpful function for ensuring the folder exists.

First, set the library reference Microsoft Scripting Runtime

This function works by passing in the folderPath (make sure you have it formatted with your systems PathSeparator) and it will split that path into an array.

Then the code iterates each path, building on top of each one create each sub folder as needed.

Lastly, if all goes well the return value will be True

' Creates a full path, iterating at each
' step. FSO.CreateFolder only does a single level.
' @LibraryReference {Microsoft Scripting Runtime}
Public Function EnusureFolderExists(ByVal folderPath As String) As Boolean
On Error GoTo catch
    ' Separate the paths
    Dim paths() As String
    paths = Split(folderPath, Application.PathSeparator)
    
    Dim fso As Scripting.FileSystemObject
    Set fso = New Scripting.FileSystemObject
    
    With New Scripting.FileSystemObject
        Dim pathIndex As Integer
        For pathIndex = LBound(paths, 1) To UBound(paths, 1)
            ' Each iteration will build the next
            ' level of the full path
            Dim currentPath As String
            currentPath = currentPath & paths(pathIndex) & Application.PathSeparator
            
            ' If current iteration doesn't exist then
            ' create it
            If Not .FolderExists(currentPath) Then
                .createFolder currentPath
            End If
        Next
        
        ' No failures, returns if it exists
        EnusureFolderExists = .FolderExists(folderPath)
    End With
    
Exit Function
catch:
    ' On any error it will return false
End Function