检查目标目录是否存在,如果不存在则继续创建它,然后继续进行 VBA
声明:本页面是StackOverFlow热门问题的中英对照翻译,遵循CC BY-SA 4.0协议,如果您需要使用它,必须同样遵循CC BY-SA许可,注明原文地址和作者信息,同时你必须将它归于原作者(不是我):StackOverFlow
原文地址: http://stackoverflow.com/questions/22325610/
Warning: these are provided under cc-by-sa 4.0 license. You are free to use/share it, But you must attribute it to the original authors (not me):
StackOverFlow
Check is destination directory exist then proceed if not then create it and proceed afterwards VBA
提问by AlexB
I have a button on one of the worksheets that lets user to continue with his task to save his/her template as a separate workbook in the folder.
我在其中一张工作表上有一个按钮,允许用户继续他的任务,将他/她的模板保存为文件夹中的单独工作簿。
here is my code
这是我的代码
Private Sub ContinueButton_Click()
Application.ScreenUpdating = 0
Sheets(cmbSheet.Value).Visible = True
Application.Goto Sheets(cmbSheet.Value).[a22], True
Application.ScreenUpdating = 1
Unload Me
End Sub
Now what I need is to check if that folder exist, in case if the folder does not exist my user should be able to create it.
现在我需要检查该文件夹是否存在,如果该文件夹不存在,我的用户应该能够创建它。
My code to create this folder is here below, but how to connect this 2 functions together I simply have no idea, since I am fairly new to VBA
我创建这个文件夹的代码在下面,但是如何将这两个函数连接在一起我根本不知道,因为我对 VBA 相当陌生
Sub CreateDirectory()
Dim sep As String
sep = Application.PathSeparator
'sets the workbook's path as the current directory
ChDir ThisWorkbook.Path
MsgBox "The current directory is:" & vbCrLf & CurDir
'makes new folder in current directory
MkDir CurDir & sep & Settings.Range("C45").Value
MsgBox "The archive directory named " & Settings.Range("C45").Value & " has been created. The path to your directory " & Settings.Range("C45").Value & " is below. " & vbCrLf & CurDir & sep & Settings.Range("C45").Value
End Sub
please help me
请帮我
回答by AKS
I am going to modularize your code a little bit:
我将稍微模块化您的代码:
First get the directory path here
首先在这里获取目录路径
Function getDirectoryPath()
getDirectoryPath = ThisWorkbook.Path & Application.PathSeparator & Settings.Range("C45").Value
End Function
You can create the directory using this function
您可以使用此功能创建目录
Sub createDirectory(directoryPath)
MkDir directoryPath
End Sub
You can check if a directory exists or not using Dir
function
您可以使用Dir
函数检查目录是否存在
Dir(directoryPath, vbDirectory) 'empty string means directoryPath doesn't exist
The final function on button click:
按钮单击的最终功能:
Private Sub ContinueButton_Click()
Application.ScreenUpdating = 0
Sheets(cmbSheet.Value).Visible = True
directoryPath = getDirectoryPath
'Creating the directory only if it doesn't exist
If Dir(directoryPath, vbDirectory) = "" Then
createDirectory directoryPath
End If
Application.Goto Sheets(cmbSheet.Value).[a22], True
Application.ScreenUpdating = 1
Unload Me
End Sub
回答by Lurds
I created a macro that will save as pdf certain tabs of my excel in a relative (variable)folder. It will use the contract reference to create a subfolder, such subfolder label is exactly the contract reference. If subfolder already exists it just creates the files in it, else (subfolder does not exist) then it creates the folder and save the files in it.
我创建了一个宏,将我的 excel 的某些选项卡保存为 pdf 格式,并保存在相关(变量)文件夹中。它将使用合同引用创建一个子文件夹,这样的子文件夹标签就是合同引用。如果子文件夹已经存在,它只会在其中创建文件,否则(子文件夹不存在)然后它会创建文件夹并将文件保存在其中。
Sub Gera_PDF_MG_Nao_Produtor_Sem_Ajuste()
Gera_PDF_MG_Nao_Produtor_Sem_Ajuste Macro
Dim MyFolder As String
Dim LaudoName As String
Dim NF1Name As String
MyFolder = ThisWorkbook.path & "\" & Sheets("Laudo").Range("C9")
LaudoName = Sheets("Laudo").Range("K27")
NF1Name = Sheets("MG sem crédito e sem ajuste").Range("Q3")
Sheets("Laudo").Select
Columns("D:P").Select
Selection.EntireColumn.Hidden = True
If Dir(MyFolder, vbDirectory) <> "" Then
Sheets("Laudo").ExportAsFixedFormat Type:=xlTypePDF, filename:=MyFolder & "\" & LaudoName & ".pdf", Quality:=xlQualityMinimum, _
IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:= _
False
Sheets("MG sem crédito e sem ajuste").ExportAsFixedFormat Type:=xlTypePDF, filename:=MyFolder & "\" & NF1Name & ".pdf", Quality:=xlQualityMinimum, _
IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:= _
False
Else
MkDir MyFolder
Sheets("Laudo").ExportAsFixedFormat Type:=xlTypePDF, filename:=MyFolder & "\" & LaudoName & ".pdf", Quality:=xlQualityMinimum, _
IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:= _
False
Sheets("MG sem crédito e sem ajuste").ExportAsFixedFormat Type:=xlTypePDF, filename:=MyFolder & "\" & NF1Name & ".pdf", Quality:=xlQualityMinimum, _
IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:= _
False
End If
Sheets("Laudo").Select
Columns("C:Q").Select
Selection.EntireColumn.Hidden = False
Range("A1").Select
'
End Sub
回答by Subash Sukumari
If Dir(Fldrpath, vbDirectory) = "" Then
MkDir Fldrpath
End If
Fldrpathrefer to the Folderpath if Folder not found MkDircreates the folder
如果文件夹未找到MkDir创建文件夹,则Fldrpath指文件夹路径