Oct 16 2022 11:18 PM - edited Oct 17 2022 01:33 AM
Oct 16 2022 11:18 PM - edited Oct 17 2022 01:33 AM
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.
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
'Saves active worksheet as pdf using concatenation
Dim fName As String
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
Oct 17 2022 12:23 AM
@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
Oct 17 2022 01:06 AM
Oct 17 2022 02:55 AM - edited Oct 17 2022 08:27 AMSolution
<< ... 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:
In design there are going to be multiple options, so just take the following as a suggestion.
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
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.
Oct 18 2022 04:23 AM
Oct 18 2022 10:17 AM - edited Oct 24 2022 04:14 AM
Sorry, another question.
Using the same coding as before but create a folder and then saving the worksheet in excel format in that folder.