SOLVED

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

Contributor

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

5 Replies

@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
Where should I add the code, before or after the Sub Macro1()
best response confirmed by Janedb (Contributor)
Solution

@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.

The previous code had an error but it is working now. Excellent, thank you!

Sorry, another question. 

 

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