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.
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
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 AM
Solution<< ... 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
Miscellaneous notes:
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.
Oct 17 2022 02:55 AM - edited Oct 17 2022 08:27 AM
Solution<< ... 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
Miscellaneous notes:
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.