Forum Discussion
Creating a folder in excel using VBA and then saving a sheet as pdf in that folder
- Oct 17, 2022
<< ... 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:
- Determine the filename and the fully-qualified directory name (in part by picking values out from specific cells in the currently-active worksheet).
- Create the directory if it does not already exist.
- 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...).
- OTOH, if the directory is now available (whether it already existed or was just created), save the active worksheet (as a PDF) in it.
- 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.
- 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.)
- 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.)
- 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.
- Write code in SaveFinancialDataToPlace1 to check the result of calling MakeDirectoryAsNeeded and act accordingly.
- Similar to step 3, create a third procedure to do this work (mostly covered by the SaveAsPDF procedure). I will call this function ExportWorksheetAsPDF.
- Write code in SaveFinancialDataToPlace1 to call this function, passing to it the name of the worksheet, the fully-qualified directory name and filename.
- 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.