Option Explicit
' ----------------------------------------------------------------
' Procedure Name: CopyPasteToolings
' Purpose: Update various files' Tooling data worksheet.
' Procedure Kind: Sub
' Procedure Access: Public
' Author: Jim
' Date: 10/3/2022
' ----------------------------------------------------------------
Sub CopyPasteToolings()
' Workbook object for Target workbook
Dim wbTarget As Workbook
' Worksheet object for the Tooling worksheet in the Master workbook.
Dim wsMasterTooling As Worksheet
' Worksheet object for the just opened workbook.
Dim wsTargetTooling As Worksheet
' Array holding folder names.
Dim asFolders() As String
' This is the name of the template file to update.
' Dim sTemplateFileName As String
' Count of folders to process.
Dim iFoldersCount As Long
' Used to loop through folders.
Dim iFolder As Long
' Count of files in folder.
Dim iFilesCount As Long
Dim iFoldersAbove As Long
' Count of files in folder.
Dim iWorkbooksCount As Long
' Folder containing the source and target folders.
Dim sBasePath As String
' Full path plus filename
Dim sFileSpec As String
' Used to store the list of files after from the Dir function.
Dim vFiles As Variant
' Name of template file to process.
' sTemplateFileName = "Setup Sheet Template.xlsx"
' ------------------------------------------------------------
' Specify folders containing workbooks to update
' ------------------------------------------------------------
' Specify the number of folders to process.
iFoldersCount = 2
' Resize array to accommodate all folder names.
ReDim asFolders(iFoldersCount) '<< set the Redim value to the number of folders to process
' Load array with folder names. IDEALLY these are from values in a worksheet. That
' way you do not have to access this code to change the folders to be accessed.
'
asFolders(1) = "Milling"
asFolders(2) = "Turning"
Application.ScreenUpdating = False
' Master workbook has a worksheet named Tooling. Set the wsMasterTooling
' worksheet object to point to that Tooling worksheet.
Set wsMasterTooling = ThisWorkbook.Worksheets(ActiveSheet.Name)
' How many folders above the one for this file are the folders containing data files?
iFoldersAbove = 0
' ----------------------------------
' Setup The sBasePath
' ----------------------------------
' Master is in the same folder as the folders containg worksheets to update.
If iFoldersAbove = 0 _
Then
' Get the base path for all folders being processed if they are in the same folder as this workbook.
sBasePath = ThisWorkbook.Path & "\"
' Target file folders are located in the folder one above this file's folder.
ElseIf iFoldersAbove = 1 _
Then
' Get the base path for all folders being processed if they are in a folder that is 1 folder up.
sBasePath = Left(ThisWorkbook.Path, InStrRev(ThisWorkbook.Path, "\") - 1) & "\"
' Target file folders are located in the folder two above this file's folder.
ElseIf iFoldersAbove = 2 _
Then
' Get folder one above where this file is located.
sBasePath = Left(ThisWorkbook.Path, InStrRev(ThisWorkbook.Path, "\") - 1)
' Get folder two above the one where this file is located.
sBasePath = Left(sBasePath, InStrRev(sBasePath, "\") - 1) & "\"
End If
' -------------------------------------
' Iterate through folders
' -------------------------------------
' Iterate through the folders containing the data files.
For iFolder = 1 To iFoldersCount
vFiles = Dir(sBasePath & asFolders(iFolder) & "\")
' -------------------------------------
' Iterate through files
' -------------------------------------
While (vFiles <> "")
iFilesCount = iFilesCount + 1
' This is the full "file specification" with full path and filename.
sFileSpec = sBasePath & asFolders(iFolder) & "\" & vFiles
Set wbTarget = Nothing
' Point the wbTarget object to the workbook that is opened.
' If the file being processed is not an Excel workbook then
' this would cause an error.
On Error Resume Next
Set wbTarget = Workbooks.Open(sFileSpec)
On Error GoTo 0
' Exclude pdf files which WILL open in Excel
If Right(sFileSpec, 3) = "pdf" _
Then
Application.DisplayAlerts = False
wbTarget.Close
Application.DisplayAlerts = True
' Check that the workbook exists before processing the file.
ElseIf Not wbTarget Is Nothing _
Then
With wbTarget
Set wsTargetTooling = Nothing
' Point the wsTargetTooling object to the Tooling worksheet.
' If the workbook being processed does not contain the specified
' worksheet (Tooling) then this would cause an error.
On Error Resume Next
Set wsTargetTooling = wbTarget.Worksheets("Tooling")
On Error GoTo 0
' Check that the worksheet exists before processing the file.
If Not wsTargetTooling Is Nothing _
Then
' ------------------------------------------------
' Call sub that does the updates.
' ------------------------------------------------
Call UpdateFile(wsMasterTooling, wsTargetTooling)
iWorkbooksCount = iWorkbooksCount + 1
End If 'Not wsTargetTooling Is Nothing
' Close the file, save changes
.Close SaveChanges:=True
End With 'wbTarget
End If 'Not wbTarget Is Nothing
vFiles = Dir
Wend
Next iFolder
' --------------------------------------------------
' Update file Setup Sheet Template
' --------------------------------------------------
' On Error Resume Next
' Set wbTarget = Workbooks.Open(ThisWorkbook.Path & "\" & sTemplateFileName)
' On Error GoTo 0
' If Not wbTarget Is Nothing _
' Then
' With wbTarget
' On Error Resume Next
' Set wsTargetTooling = .Worksheets("Tooling")
' On Error GoTo 0
' Do the update of the workbook, call sub that does it.
' If Not wsTargetTooling Is Nothing _
' Then
' Call UpdateFile(wsMasterTooling, wsTargetTooling)
' End If
' Close the file, save changes
' .Close SaveChanges:=True
' increment files processed count and workbooks updated count
' iFilesCount = iFilesCount + 1
' iWorkbooksCount = iWorkbooksCount + 1
' End With
' End If
' -----------------------
' Closeout
' -----------------------
Application.CutCopyMode = False
MsgBox "Done processing " & iFilesCount & " files." & Chr(10) _
& iWorkbooksCount & " were Tooling workbooks", _
vbInformation, _
"Updating files with Toolings data"
End Sub
