Forum Discussion

Janedb's avatar
Janedb
Iron Contributor
Oct 17, 2022
Solved

Creating a folder in excel using VBA and then saving a sheet as pdf in that folder

HI All, I am struggling to combine two VBA's in one function to create a folder and then saving the worksheet into the newly created folder. It should first look if a folder with the name already exists and if not then it should create a folder that is specified with a specific field in the worksheet. When the folder is created then the VBA should save the worksheet as a pdf and save it in the newly created folder.

 

This is the two VBA's that I started but I dont know how to combine them to run together.

 

Sub Macro1()
Dim strFilename, strDirname, strPathname, strDefpath As String
On Error Resume Next ' If directory exist goto next line
strDirname = Range("G3").Value ' New directory name

strFilename = .Range("B5").Value & .Range("G3").Value & " " & .Range("B6").Text 'New file name
strDefpath = "C:\Users\******\Dropbox\*******\Financials\Job Sheets\"
If IsEmpty(strDirname) Then Exit Sub
If IsEmpty(strFilename) Then Exit Sub

MkDir strDefpath & "\" & strDirname
strPathname = strDefpath & "\" & strDirname & "\" & strFilename 'create total string
End Sub

Sub SaveAsPDF()
'Saves active worksheet as pdf using concatenation
'of A1,A2,A3

Dim fName As String
With ActiveSheet
fName = .Range("B14").Value & "-" & .Range("I14").Value & " " & .Range("K6").Text & " " & .Range("K7").Value
.ExportAsFixedFormat Type:=xlTypePDF, Filename:= _
"C:\Users\******\Dropbox\*******\Financials\Job Sheets\" & fName, Quality:=xlQualityStandard, _
IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=True
End With
End Sub

  • Janedb 

    << ... I dont know how to combine them to run together >>
    As you were able to copy your VBA procedures into your post, I will assume that you are not having a problem in using the VBA Editor.

     

    Your two procedures have different values (names) for the directories and files to be used. You'll need to use consistent values; you'll see how I handle that by defining/evaluating them in just one place in the code.

     

    So overall, this is a question of design. But first, let's confirm what needs to be done. The code should do these tasks:

    1. Determine the filename and the fully-qualified directory name (in part by picking values out from specific cells in the currently-active worksheet).
    2. Create the directory if it does not already exist.
    3. Do something special (issue a message and stop or quit?) if the directory does not exist and cannot be created (e.g., if the hard drive is out of space, or the user does not have permission to create the directory, or the fully-qualified directory name is longer than 255 characters or the requested name includes invalid characters or...).
    4. OTOH, if the directory is now available (whether it already existed or was just created), save the active worksheet (as a PDF) in it.
    5. Do something special (issue a message and stop or quit?) if the worksheet could not be saved, or provide some indication of success if it could be saved.

     

    In design there are going to be multiple options, so just take the following as a suggestion.

    1. Create a new procedure (probably a Sub) that is overall in charge of the tasks. I will call it SaveFinancialDataToPlace1. (it's possible that "Place1" should be "Invoicing", but I cannot safely assume that.)
    2. Within SaveFinancialDataToPlace1, place the code to carry out task #1. (I recommend that _this_ is the place for grabbing all needed information from the specific cells, not in Macro1.)
    3. Task #2 is generic work (i.e., you may want this capability for future projects) , so put it into a second procedure which you will call ("invoke"), passing to it the fully-qualified directory name. The second procedure will be a Function rather than a Sub, using some of the code in Macro1, and it will pass information back to tell SaveFinancialDataToPlace1 whether it was successful. I will call this procedure MakeDirectoryAsNeeded.
    4. Write code in SaveFinancialDataToPlace1 to check the result of calling MakeDirectoryAsNeeded and act accordingly.
    5. Similar to step 3, create a third procedure to do this work (mostly covered by the SaveAsPDF procedure). I will call this function ExportWorksheetAsPDF.
    6. Write code in SaveFinancialDataToPlace1 to call this function, passing to it the name of the worksheet, the fully-qualified directory name and filename.
    7. Write code in SaveFinancialDataToPlace1 to check the result of calling ExportWorksheetAsPDF, and act accordingly.

    As that may seem vague, here's code for what I'm suggesting:

     

    Public Sub SaveFinancialDataToPlace1()
    '   This procedure extracts information from specific cells in the active
    '       worksheet to determine where to save the [...?] data; it then
    '       determines where to save the worksheet data, and saves it there as
    '       a PDF file.
    
        Const strPROCEDURE_NAME As String = "SaveFinancialDataToPlace1"
        Const strBASE_PATH As String = _
            "C:\Users\De Bruin Home\Dropbox\OCEANLINK\OCEANLINKLAUNCH\Financials\Job Sheets\"
        
        Dim strWorksheetName    As String
        Dim strFilename     As String
        Dim strDirname      As String   'the subdirectory name
        Dim strFullDirName As String
        Dim strPathname     As String
        Dim strResult   As String
        
        '----   Clear any prior message in the status bar.
        Application.StatusBar = ""
        
        '----   Capture here the identity of the active worksheet.
        strWorksheetName = ActiveSheet.Name
        
        '----   Retrieve values from the worksheet.
        With Worksheets(strWorksheetName)
            strDirname = .Range("G3").Value ' New directory name
            strFilename = .Range("B5").Value & .Range("G3").Value & " " _
                    & .Range("B6").Text 'New file name
        End With
        If strDirname = "" Then
            Call MsgBox("Cell G3 needs to contain a subdirectory name." _
                    , vbExclamation Or vbOKOnly, strPROCEDURE_NAME)
            Exit Sub
        End If
        '       (More simple validation could be included here.) #ToDo
        
        '----   Derive related values.
        strFullDirName = strBASE_PATH & "\" & strDirname
        strPathname = strFullDirName & "\" & strFilename
        
        '----   Ensure that the desired destination directory exists.
        strResult = MakeDirectoryAsNeeded(strFullDirName)
        If strResult <> "Success" Then
            Call MsgBox("Problem regarding the destination directory (" _
                    & strFullDirName & "):" & vbCrLf & strResult)
            Exit Sub
        End If
        
        '----   Save the worksheet as a PDF file.
        strResult = ExportWorksheetAsPDF(strWorksheetName, strPathname)
        If strResult = "Success" Then
            Application.StatusBar = "Worksheet " & strWorksheetName _
                    & " was successfully exported to a PDF"
        Else
            Application.StatusBar = "Processing error!"
            Call MsgBox("Error while saving worksheet " & strWorksheetName _
                    & ":" & vbCrLf & strResult, vbExclamation Or vbOKOnly _
                    , strPROCEDURE_NAME)
            Exit Sub    '(to be explicit)
        End If
    
    End Sub
    
    
    Public Function MakeDirectoryAsNeeded(ByVal FullDirectoryName As String) _
            As String
    
        Dim strReturnValue      As String
        
        Dim in4ErrorCode    As Long
        Dim strErrorDescr   As String
        Dim in4Attribute    As VbFileAttribute
        
        '----   Check to see if the directory already exists.
        On Error Resume Next    '(It is likely that the next statment _
                will cause a processing error.)
        in4Attribute = GetAttr(FullDirectoryName)
        in4ErrorCode = Err.Number
        strErrorDescr = Err.Description
        On Error GoTo 0
        Select Case in4ErrorCode
            Case 0
                '...the file system object exists. Do a further check.
                If in4Attribute And vbDirectory Then
                    '...the directory already exists.  Treat that as a
                    '   successful execution.
                    strReturnValue = "Success"
                    GoTo MakeDirAsNeeded_Exit
                Else
                    strReturnValue = "The file system object " _
                            & FullDirectoryName _
                            & " already exists as a regular file."
                    GoTo MakeDirAsNeeded_Exit
                End If
            Case 53
                '...the directory does not exist.  Continue.
            Case Else
                strReturnValue = strErrorDescr
                GoTo MakeDirAsNeeded_Exit
        End Select
        
        '----   Attempt to create the directory; return the VBA-supplied
        '       error description if a processing error occurs.
        On Error Resume Next
        MkDir FullDirectoryName
        in4ErrorCode = Err.Number
        strErrorDescr = Err.Description
        On Error GoTo 0
        Select Case in4ErrorCode
            Case 0  'no processing error
                '...that code created the directory.
                strReturnValue = "Success"
            Case Else
                strReturnValue = strErrorDescr
        End Select
    MakeDirAsNeeded_Exit:
        MakeDirectoryAsNeeded = strReturnValue
        Exit Function
    End Function
    
    
    Public Function ExportWorksheetAsPDF(ByVal WorksheetName As String _
            , ByVal ToPathname As String) As String
    
        Dim strReturnValue      As String
        
        '----
        On Error GoTo ExportWkshtAsPDF_ErrHandler
        With Worksheets(WorksheetName)
            .ExportAsFixedFormat Type:=xlTypePDF, Filename:=ToPathname _
                , Quality:=xlQualityStandard, IncludeDocProperties:=True _
                , IgnorePrintAreas:=False, OpenAfterPublish:=True
        End With
        strReturnValue = "Success"
    ExportWkshtAsPDF_Exit:
        ExportWorksheetAsPDF = strReturnValue
        Exit Function
    
    ExportWkshtAsPDF_ErrHandler:
        strReturnValue = Err.Description
        Resume ExportWkshtAsPDF_Exit
    End Function

     

     

    Miscellaneous notes:

    • The "On Error Resume Next" statement hides processing errors (within its procedure), and so it should be used cautiously. Specifically, rarely should you put that at the top of a procedure.
    • Dim strFilename, strDirname, strPathname, strDefpath As String - Only strDefpath is defined as a String; the other variables are each implicitly defined as a Variant. That's typically not a problem, but if you want each to be a String, the syntax is "Dim strFilename As String, strDirname As String, strPathname As String, strDefpath As String" (or define them on multiple lines).

    I think I was going to comment on something else, but it's late, and my brain is shutting down.

     

    Edit - Note that in VBA, the code to tell a function what value to return is to assign the value to the function name, e.g., MakeDirectoryAsNeeded = strReturnValue

     

    Edit - Added a line of code to clear the status bar just as the main procedure starts; replaced the code for MakeDirectoryAsNeeded, as it was faulty.

5 Replies

  • SnowMan55's avatar
    SnowMan55
    Bronze Contributor

    Janedb 

    << ... I dont know how to combine them to run together >>
    As you were able to copy your VBA procedures into your post, I will assume that you are not having a problem in using the VBA Editor.

     

    Your two procedures have different values (names) for the directories and files to be used. You'll need to use consistent values; you'll see how I handle that by defining/evaluating them in just one place in the code.

     

    So overall, this is a question of design. But first, let's confirm what needs to be done. The code should do these tasks:

    1. Determine the filename and the fully-qualified directory name (in part by picking values out from specific cells in the currently-active worksheet).
    2. Create the directory if it does not already exist.
    3. Do something special (issue a message and stop or quit?) if the directory does not exist and cannot be created (e.g., if the hard drive is out of space, or the user does not have permission to create the directory, or the fully-qualified directory name is longer than 255 characters or the requested name includes invalid characters or...).
    4. OTOH, if the directory is now available (whether it already existed or was just created), save the active worksheet (as a PDF) in it.
    5. Do something special (issue a message and stop or quit?) if the worksheet could not be saved, or provide some indication of success if it could be saved.

     

    In design there are going to be multiple options, so just take the following as a suggestion.

    1. Create a new procedure (probably a Sub) that is overall in charge of the tasks. I will call it SaveFinancialDataToPlace1. (it's possible that "Place1" should be "Invoicing", but I cannot safely assume that.)
    2. Within SaveFinancialDataToPlace1, place the code to carry out task #1. (I recommend that _this_ is the place for grabbing all needed information from the specific cells, not in Macro1.)
    3. Task #2 is generic work (i.e., you may want this capability for future projects) , so put it into a second procedure which you will call ("invoke"), passing to it the fully-qualified directory name. The second procedure will be a Function rather than a Sub, using some of the code in Macro1, and it will pass information back to tell SaveFinancialDataToPlace1 whether it was successful. I will call this procedure MakeDirectoryAsNeeded.
    4. Write code in SaveFinancialDataToPlace1 to check the result of calling MakeDirectoryAsNeeded and act accordingly.
    5. Similar to step 3, create a third procedure to do this work (mostly covered by the SaveAsPDF procedure). I will call this function ExportWorksheetAsPDF.
    6. Write code in SaveFinancialDataToPlace1 to call this function, passing to it the name of the worksheet, the fully-qualified directory name and filename.
    7. Write code in SaveFinancialDataToPlace1 to check the result of calling ExportWorksheetAsPDF, and act accordingly.

    As that may seem vague, here's code for what I'm suggesting:

     

    Public Sub SaveFinancialDataToPlace1()
    '   This procedure extracts information from specific cells in the active
    '       worksheet to determine where to save the [...?] data; it then
    '       determines where to save the worksheet data, and saves it there as
    '       a PDF file.
    
        Const strPROCEDURE_NAME As String = "SaveFinancialDataToPlace1"
        Const strBASE_PATH As String = _
            "C:\Users\De Bruin Home\Dropbox\OCEANLINK\OCEANLINKLAUNCH\Financials\Job Sheets\"
        
        Dim strWorksheetName    As String
        Dim strFilename     As String
        Dim strDirname      As String   'the subdirectory name
        Dim strFullDirName As String
        Dim strPathname     As String
        Dim strResult   As String
        
        '----   Clear any prior message in the status bar.
        Application.StatusBar = ""
        
        '----   Capture here the identity of the active worksheet.
        strWorksheetName = ActiveSheet.Name
        
        '----   Retrieve values from the worksheet.
        With Worksheets(strWorksheetName)
            strDirname = .Range("G3").Value ' New directory name
            strFilename = .Range("B5").Value & .Range("G3").Value & " " _
                    & .Range("B6").Text 'New file name
        End With
        If strDirname = "" Then
            Call MsgBox("Cell G3 needs to contain a subdirectory name." _
                    , vbExclamation Or vbOKOnly, strPROCEDURE_NAME)
            Exit Sub
        End If
        '       (More simple validation could be included here.) #ToDo
        
        '----   Derive related values.
        strFullDirName = strBASE_PATH & "\" & strDirname
        strPathname = strFullDirName & "\" & strFilename
        
        '----   Ensure that the desired destination directory exists.
        strResult = MakeDirectoryAsNeeded(strFullDirName)
        If strResult <> "Success" Then
            Call MsgBox("Problem regarding the destination directory (" _
                    & strFullDirName & "):" & vbCrLf & strResult)
            Exit Sub
        End If
        
        '----   Save the worksheet as a PDF file.
        strResult = ExportWorksheetAsPDF(strWorksheetName, strPathname)
        If strResult = "Success" Then
            Application.StatusBar = "Worksheet " & strWorksheetName _
                    & " was successfully exported to a PDF"
        Else
            Application.StatusBar = "Processing error!"
            Call MsgBox("Error while saving worksheet " & strWorksheetName _
                    & ":" & vbCrLf & strResult, vbExclamation Or vbOKOnly _
                    , strPROCEDURE_NAME)
            Exit Sub    '(to be explicit)
        End If
    
    End Sub
    
    
    Public Function MakeDirectoryAsNeeded(ByVal FullDirectoryName As String) _
            As String
    
        Dim strReturnValue      As String
        
        Dim in4ErrorCode    As Long
        Dim strErrorDescr   As String
        Dim in4Attribute    As VbFileAttribute
        
        '----   Check to see if the directory already exists.
        On Error Resume Next    '(It is likely that the next statment _
                will cause a processing error.)
        in4Attribute = GetAttr(FullDirectoryName)
        in4ErrorCode = Err.Number
        strErrorDescr = Err.Description
        On Error GoTo 0
        Select Case in4ErrorCode
            Case 0
                '...the file system object exists. Do a further check.
                If in4Attribute And vbDirectory Then
                    '...the directory already exists.  Treat that as a
                    '   successful execution.
                    strReturnValue = "Success"
                    GoTo MakeDirAsNeeded_Exit
                Else
                    strReturnValue = "The file system object " _
                            & FullDirectoryName _
                            & " already exists as a regular file."
                    GoTo MakeDirAsNeeded_Exit
                End If
            Case 53
                '...the directory does not exist.  Continue.
            Case Else
                strReturnValue = strErrorDescr
                GoTo MakeDirAsNeeded_Exit
        End Select
        
        '----   Attempt to create the directory; return the VBA-supplied
        '       error description if a processing error occurs.
        On Error Resume Next
        MkDir FullDirectoryName
        in4ErrorCode = Err.Number
        strErrorDescr = Err.Description
        On Error GoTo 0
        Select Case in4ErrorCode
            Case 0  'no processing error
                '...that code created the directory.
                strReturnValue = "Success"
            Case Else
                strReturnValue = strErrorDescr
        End Select
    MakeDirAsNeeded_Exit:
        MakeDirectoryAsNeeded = strReturnValue
        Exit Function
    End Function
    
    
    Public Function ExportWorksheetAsPDF(ByVal WorksheetName As String _
            , ByVal ToPathname As String) As String
    
        Dim strReturnValue      As String
        
        '----
        On Error GoTo ExportWkshtAsPDF_ErrHandler
        With Worksheets(WorksheetName)
            .ExportAsFixedFormat Type:=xlTypePDF, Filename:=ToPathname _
                , Quality:=xlQualityStandard, IncludeDocProperties:=True _
                , IgnorePrintAreas:=False, OpenAfterPublish:=True
        End With
        strReturnValue = "Success"
    ExportWkshtAsPDF_Exit:
        ExportWorksheetAsPDF = strReturnValue
        Exit Function
    
    ExportWkshtAsPDF_ErrHandler:
        strReturnValue = Err.Description
        Resume ExportWkshtAsPDF_Exit
    End Function

     

     

    Miscellaneous notes:

    • The "On Error Resume Next" statement hides processing errors (within its procedure), and so it should be used cautiously. Specifically, rarely should you put that at the top of a procedure.
    • Dim strFilename, strDirname, strPathname, strDefpath As String - Only strDefpath is defined as a String; the other variables are each implicitly defined as a Variant. That's typically not a problem, but if you want each to be a String, the syntax is "Dim strFilename As String, strDirname As String, strPathname As String, strDefpath As String" (or define them on multiple lines).

    I think I was going to comment on something else, but it's late, and my brain is shutting down.

     

    Edit - Note that in VBA, the code to tell a function what value to return is to assign the value to the function name, e.g., MakeDirectoryAsNeeded = strReturnValue

     

    Edit - Added a line of code to clear the status bar just as the main procedure starts; replaced the code for MakeDirectoryAsNeeded, as it was faulty.

    • Janedb's avatar
      Janedb
      Iron Contributor

      Sorry, another question. 

       

      Using the same coding as before but create a folder and then saving the worksheet in excel format in that folder.

       

    • Janedb's avatar
      Janedb
      Iron Contributor
      The previous code had an error but it is working now. Excellent, thank you!
  • Harun24HR's avatar
    Harun24HR
    Bronze Contributor

    Janedb In a command assign a macro and call that two macro by name. Try the follow codes.

    Sub Button1_Click()
        Call Macro1
        Call SaveAsPDF
    End Sub
    • Janedb's avatar
      Janedb
      Iron Contributor
      Where should I add the code, before or after the Sub Macro1()

Resources