创建文件夹、子文件夹、另一个子文件夹并根据单元格值保存自定义文件名 vba
Creating folders, subfolder, another subfolder and saving custom file name based on cell value vba
我正在尝试检查路径中的文件夹 1、2 和 3 是否存在。
例如:C:\Users\%USERNAME%\Documents\Folder 1\Folder 2\Folder 3\
如果它们不存在,它应该创建每个文件夹,然后将工作簿保存在文件夹 3 中。
所有文件夹名称和文件名称都取决于单元格值。
不确定我做错了什么。
Sub Macro1()
Dim folderPath As String
Dim individualFolders() As String
Dim tempFolderPath As String
Dim arrayElement As Variant
folderPath = "C:\Users\%USERNAME%\Documents" & "\" & Worksheets("Sheet1").Range("A10").Value & "\" & Worksheets("Sheet1").Range("B10").Value & "\" & Worksheets("Sheet1").Range("C10").Value
individualFolders = Split(folderPath, "\")
For Each arrayElement In individualFolders
tempFolderPath = tempFolderPath & arrayElement & "\"
If Dir(tempFolderPath, vbDirectory) = "" Then
MkDir tempFolderPath
End If
Next arrayElement
strFilename = Worksheets("Sheet1").Range("C1").Value 'New file name
strDefpath = Environ("USERPROFILE") & "\Documents\" & Worksheets("Sheet1").Range("A10").Value & "\" & Worksheets("Sheet1").Range("B10").Value & "\" & Worksheets("Sheet1").Range("C10").Value
If IsEmpty(strDirname) Then Exit Sub
If IsEmpty(strFilename) Then Exit Sub
MkDir strDefpath & "\" & strDirname
strPathname = strDefpath & "\" & strDirname & "\" & strFilename 'create total string
Application.DisplayAlerts = False
ActiveWorkbook.SaveAs Filename:=strPathname & ".xlsm", _
FileFormat:=xlOpenXMLWorkbookMacroEnabled, Password:="", WriteResPassword:="", _
ReadOnlyRecommended:=False, CreateBackup:=False
End Sub
您正在混合通常在 cmd
中使用的语法,即命令提示符与 vba
。
请注意,%USERNAME%
是一个环境变量,它在命令提示符中可用,但在 Excel 中不可用。
但是,可以从 VBA 调用命令提示符,如下所示。
folderpath = Chr(34) & "C:\Users\%USERNAME%\Documents\" & Worksheets("Sheet1").Range("A10").Value & "\" & Worksheets("Sheet1").Range("B10").Value & "\" & Worksheets("Sheet1").Range("C10").Value & Chr(34)
Shell "cmd /k mkdir " & folderpath, vbHide
这应该能够一次性创建所有不存在的文件夹(从单元格 A10 到 C10)!
我正在尝试检查路径中的文件夹 1、2 和 3 是否存在。
例如:C:\Users\%USERNAME%\Documents\Folder 1\Folder 2\Folder 3\
如果它们不存在,它应该创建每个文件夹,然后将工作簿保存在文件夹 3 中。 所有文件夹名称和文件名称都取决于单元格值。
不确定我做错了什么。
Sub Macro1()
Dim folderPath As String
Dim individualFolders() As String
Dim tempFolderPath As String
Dim arrayElement As Variant
folderPath = "C:\Users\%USERNAME%\Documents" & "\" & Worksheets("Sheet1").Range("A10").Value & "\" & Worksheets("Sheet1").Range("B10").Value & "\" & Worksheets("Sheet1").Range("C10").Value
individualFolders = Split(folderPath, "\")
For Each arrayElement In individualFolders
tempFolderPath = tempFolderPath & arrayElement & "\"
If Dir(tempFolderPath, vbDirectory) = "" Then
MkDir tempFolderPath
End If
Next arrayElement
strFilename = Worksheets("Sheet1").Range("C1").Value 'New file name
strDefpath = Environ("USERPROFILE") & "\Documents\" & Worksheets("Sheet1").Range("A10").Value & "\" & Worksheets("Sheet1").Range("B10").Value & "\" & Worksheets("Sheet1").Range("C10").Value
If IsEmpty(strDirname) Then Exit Sub
If IsEmpty(strFilename) Then Exit Sub
MkDir strDefpath & "\" & strDirname
strPathname = strDefpath & "\" & strDirname & "\" & strFilename 'create total string
Application.DisplayAlerts = False
ActiveWorkbook.SaveAs Filename:=strPathname & ".xlsm", _
FileFormat:=xlOpenXMLWorkbookMacroEnabled, Password:="", WriteResPassword:="", _
ReadOnlyRecommended:=False, CreateBackup:=False
End Sub
您正在混合通常在 cmd
中使用的语法,即命令提示符与 vba
。
请注意,%USERNAME%
是一个环境变量,它在命令提示符中可用,但在 Excel 中不可用。
但是,可以从 VBA 调用命令提示符,如下所示。
folderpath = Chr(34) & "C:\Users\%USERNAME%\Documents\" & Worksheets("Sheet1").Range("A10").Value & "\" & Worksheets("Sheet1").Range("B10").Value & "\" & Worksheets("Sheet1").Range("C10").Value & Chr(34)
Shell "cmd /k mkdir " & folderpath, vbHide
这应该能够一次性创建所有不存在的文件夹(从单元格 A10 到 C10)!