Option Explicit
' ----------------------------------------------------------------
' Procedure Name: MakeNewJobWorkbook
' Purpose: Creat new job workbook, add hyperlink to the file into cell whose content changed.
' Procedure Kind: Sub
' Procedure Access: Public
' Parameter psID (String): This is the job ID input by user.
' Parameter prChangedCell (Range): The cell whose value was changed.
' Parameter psNamePath (String): The name of the person used in the path.
' Parameter psTypePath (String): The job type used in the path.
' Author: Jim
' Date: 4/20/2023
' ----------------------------------------------------------------
Sub MakeNewJobWorkbook( _
psID As String, _
prChangedCell As Range, _
psNamePath As String, _
psTypePath As String)
' ----------------------------
' Declarations
' ----------------------------
' Worksheet in this workbook that user is changing.
Dim wsTargetWorksheet As Worksheet
' Path to the job files.
Dim sJobWorkbookPath As String
' The "base" name of the job workbook to save.
Dim sJobWorkbookBaseName As String
' The file name extension for the job workbook to save.
Dim sJobWorkbookNameExt As String
' Name of the the job workbook -- before ID is added -- to be created with extension.
Dim sJobWorkbookName As String
' Location of/path to the template file.
Dim sTemplateWorkbookPath As String
' File name -- with file name extension -- of the template workbook.
Dim sTemplateWorkbookName As String
' Variable used to message user.
Dim sMsg As String
' Used for user response to questions.
Dim vAns As Variant
' ----------------------------
' Initializations
' ----------------------------
' Path to/folder containing the jobs workbooks.
sJobWorkbookPath = "C:\Users\" & psNamePath & "\XXXXX\Order Book - General\" & psTypePath & "\"
' "Base" file name for the job file that will be created.
sJobWorkbookBaseName = "Job "
' File name extension for the job file that will be created.
sJobWorkbookNameExt = ".xlsm"
' Full name of the Job file to create.
sJobWorkbookName = sJobWorkbookBaseName & psID & sJobWorkbookNameExt
' Path to/folder containing the template file.
sTemplateWorkbookPath = "C:\Users\" & psNamePath & "\XXXXX\Order Book - General\"
' Name of the template workbook.
sTemplateWorkbookName = "QuoteSheetMaster.xlsm"
' Worksheet in this workbook that is changing.
Set wsTargetWorksheet = prChangedCell.Parent
' -----------------------------------------
' Handle Job File Already Exists
' -----------------------------------------
' Check if the job workbook to be saved already exists and whether user wants to replace it.
If Dir(sJobWorkbookPath & sJobWorkbookName) <> "" _
Then
sMsg = "The file named " & sJobWorkbookName & " exists. Overwrite?"
vAns = MsgBox(sMsg, vbYesNo)
' If user said no to overwrite then bail out of sub.
If vAns = vbNo Then Exit Sub
' Delete the file before creating a new version.
Kill (sJobWorkbookPath & sJobWorkbookName)
End If
' Open the template workbook. It becomes the ActiveWorkbook.
Workbooks.Open sTemplateWorkbookPath & sTemplateWorkbookName
' -----------------------------
' Save New Job File
' -----------------------------
' Save copy of the template whose name is
With ActiveWorkbook
.SaveAs sJobWorkbookPath & sJobWorkbookName
.Close
End With
' ----------------------------------------------------
' Add Link That Opens the New Job Workbook
' ----------------------------------------------------
' With the worksheet into which the new ID was placed...
With wsTargetWorksheet
' Activate it
.Activate
' Then place hyperlink to the newly created job workbook file
' into the cell into which the new ID was input.
.Hyperlinks.Add Anchor:=prChangedCell, _
Address:=sJobWorkbookPath & sJobWorkbookName, _
TextToDisplay:=psID
prChangedCell.Value = psID
End With
End Sub
