Question

我在其中一个工作表上有一个按钮，允许用户继续执行任务，将他/她的模板保存为文件夹中的单独工作簿。

这是我的代码

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

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

我创建此文件夹的代码如下所示，但如何将这2个函数连接在一起我根本不知道，因为我对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

我将模块化你的代码：

首先在这里获取目录路径

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

您可以使用此功能

创建目录

Sub createDirectory(directoryPath)
    MkDir directoryPath
End Sub

您可以使用Dir功能

检查目录是否存在

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

点击按钮的最终功能：

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

我创建了一个宏，它将我的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

Answer 3

If Dir(Fldrpath, vbDirectory) = "" Then
MkDir Fldrpath
End If

如果找不到文件夹 MkDir ，

Fldrpath 会引用文件夹路径

检查目标目录是否存在然后继续，如果没有则创建它然后继续VBA

3 个答案: