检查目标目录是否存在,如果不存在则继续创建它,然后继续进行 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

提示:将鼠标放在中文语句上可以显示对应的英文。显示中英文
时间:2020-09-08 17:58:16  来源:igfitidea点击:

Check is destination directory exist then proceed if not then create it and proceed afterwards VBA

excelvbaexcel-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 Dirfunction

您可以使用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指文件夹路径