[英]VBA - How to create new folder and sub folders and save the workbook
I am trying to save my workbooks with a button click, that directs the workbook to 2016 folder and few region subfolders like LA, NY, Denver, Chicago (which ever location, user selects). 我试图通过单击按钮保存我的工作簿,该工作簿将工作簿定向到2016文件夹以及几个区域子文件夹,如LA,NY,Denver,Chicago(用户选择的位置)。 But as moving forward, I am trying to broaden the scope of my excel tool, such that through the same button click, workbook should be able to create folders and then sub folders and save the workbook over there.
但是随着前进,我试图扩大excel工具的范围,以便通过单击同一按钮,工作簿应该能够创建文件夹,然后创建子文件夹,并将工作簿保存在那。 for eg., currently it should create folder for 2016 and the desired "region" subfolder that the user is working.
例如,当前它应该为2016和用户正在使用的所需“区域”子文件夹创建文件夹。 I have additionally managed the year value from the user in the worksheet which would be in cell "D11".
我还从工作表中的用户管理年份值,该值位于单元格“ D11”中。
Any help is much appreciated. 任何帮助深表感谢。 Thanks a lot !
非常感谢 !
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"
How about this: you split your Path into an Array, loop the array, and create the subfolders with a separate routine if they do not exist 怎么做:将Path拆分为一个数组,循环该数组,然后使用不存在的例程创建子文件夹(如果不存在)
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 utilizes the following two functions to to check if a folder exists and to create a folder: 这利用以下两个功能来检查文件夹是否存在并创建文件夹:
' 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
声明:本站的技术帖子网页,遵循CC BY-SA 4.0协议,如果您需要转载,请注明本站网址或者原文地址。任何问题请咨询:yoyou2525@163.com.