检查目标目录是否存在，如果不存在则继续创build，然后继续VBA

我在其中一个工作表上有一个button，让用户可以继续执行任务，将他/她的模板另存为文件夹中的单独工作簿。

这是我的代码

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 

现在我需要的是检查该文件夹是否存在，如果该文件夹不存在，我的用户应该能够创build它。

我的代码创build这个文件夹在这里下面，但如何将这两个function连接在一起我根本不知道，因为我是相当新的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 

请帮帮我

Answer 1

我将稍微模块化你的代码：

首先在这里获取目录path

 Function getDirectoryPath() getDirectoryPath = ThisWorkbook.Path & Application.PathSeparator & Settings.Range("C45").Value End Function 

您可以使用此function创build目录

 Sub createDirectory(directoryPath) MkDir directoryPath End Sub 

您可以使用Dir函数检查目录是否存在

 Dir(directoryPath, vbDirectory) 'empty string means directoryPath doesn't exist 

button点击的最终function：

 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 

Answer 2

我创build了一个macros，将保存为一个相对（可变）文件夹中的我的Excel的PDF某些选项卡。 它将使用合同参考来创build一个子文件夹，这样的子文件夹标签就是合同的参考。 如果子文件夹已经存在，它只是在其中创build文件，否则（子文件夹不存在），然后创build文件夹并保存文件。

 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