检查是否已经存在同名文件夹的功能答案

【问题标题】：Function that will check if there is already a folder by that name检查是否已经存在同名文件夹的功能
【发布时间】：2022-08-19 14:13:52
【问题描述】：

我正在尝试创建一个保存函数，该函数将检查是否已经有一个文件夹，其名称为 Range G3 中指定的名称，如果有，它将只保存文件。如果没有，它将使用该名称创建一个新文件夹并保存文件。

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

感谢您的帮助 = )

标签： vba if-statement excel-formula save filenames

【解决方案1】：

使用 Api（在模块中声明）

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

像这样称呼它

MakeSureDirectoryPathExists(YourFolder) 如果不存在，这将创建文件夹。

【讨论】：

【解决方案2】：

我创建了一个有用的函数来确保文件夹存在。

一、设置库引用Microsoft Scripting Runtime

此函数通过传入folderPath 来工作（确保您已将其格式化为您的系统PathSeparator），它将将该路径拆分为一个数组。

然后代码迭代每个路径，在每个路径之上根据需要创建每个子文件夹。

最后，如果一切顺利，返回值将是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

【讨论】：