Question

我试图通过单击按钮保存我的工作簿，将工作簿指向2016文件夹和少数区域子文件夹，如洛杉矶，纽约，丹佛，芝加哥（无论位置，用户选择）。但随着前进，我试图扩大我的Excel工具的范围，这样通过相同的按钮单击，工作簿应该能够创建文件夹，然后子文件夹，并将工作簿保存在那里。例如，目前它应该创建2016年的文件夹和用户正在工作的所需“区域”子文件夹。我还在工作表中管理了用户的年份值，该值将在单元格“D11”中。

非常感谢任何帮助。非常感谢！

 location = Range("D9").Value
 FileName1 = Range("D3").Value

  If location = "Chicago" Then

     ActiveWorkbook.SaveAs FileName:="S:\Audits\2016\Chicago - 07\" & FileName1 & "-" & "Audit checklist" & ".xlsm"

     ElseIf location = "Los Angeles" Then
     ActiveWorkbook.SaveAs FileName:="S:\Audits\2016\Los Angeles\" & FileName1 & "-" & "Audit checklist" & ".xlsm"

     ElseIf location = "New York" Then
     ActiveWorkbook.SaveAs FileName:="S:\Audits\2016\New York - 08\" & FileName1 & "-" & "Audit checklist" & ".xlsm"

     Else
     ActiveWorkbook.SaveAs FileName:="S:\Audits\2016\Atlanta\" & FileName1 & "-" & "Audit checklist" & ".xlsm"

Answer 1

如何：将路径拆分为数组，循环数组，如果不存在，则使用单独的例程创建子文件夹

Sub test

    Dim arrFolders() As String
    Dim item As Variant
    Dim SubFolder As String

    ' In my case, ![Outfile.Parentfolder] is my Path which i get from a recordset. Adjust this to your liking
    arrFolders = Split(![OutFile.ParentFolder], Application.PathSeparator)

    SubFolder = vbNullString

    For Each item In arrFolders
        SubFolder = SubFolder & item & Application.PathSeparator
        If Not FolderExists(SubFolder) Then FolderCreate (SubFolder)
    Next item

    ' ....

End Sub

这利用以下两个函数来检查文件夹是否存在并创建文件夹：

' This needs a reference to microsoft scripting runtime 
Function FolderCreate(ByVal path As String) As Boolean

FolderCreate = True
    Dim fso As New FileSystemObject

try:
    If fso.FolderExists(path) Then
        Exit Function
    Else
        On Error GoTo catch
        fso.CreateFolder path
        Debug.Print "FolderCreate: " & vbTab & path
        Exit Function
    End If

catch:
    MsgBox "A folder could not be created for the following path: " & path & ". Check the path name and try again."
    FolderCreate = False
    Exit Function

End Function

Function FolderExists(ByVal path As String) As Boolean

    FolderExists = False
    Dim fso As New FileSystemObject

    If fso.FolderExists(path) Then FolderExists = True

End Function

VBA - 如何创建新文件夹和子文件夹并保存工作簿

1 个答案: