Check if the destination directory exists, then continue, if you do not create it later and continue after that VBA

I have a button on one of the sheets, which allows the user to continue performing his task in order to save his template as a separate book in a 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 I need to check if this folder exists, if the folder does not exist, my user must create it.

My code for creating this folder is below, but how to connect these 2 functions together, I just have no idea, since I'm pretty new to VBA

Sub CreateDirectory()
Dim sep As String
sep = Application.PathSeparator
'sets the workbook 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

+4
source share
2 answers

I am going to simplify the code a bit:

First find the directory path

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
+9

, PDF excel () . , - . , , ( ), .

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
0

Source: https://habr.com/ru/post/1531158/


All Articles