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 exi...
  • SnowMan55's avatar
    Oct 17, 2022

    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.

Resources