Option Explicit
Private Sub Workbook_Open()
' Set local folder path
Const FolderPath As String = "\\jacksonville-dc\common\test\SOPs With New Names"
Const FileExt As String = "docx"
Dim oFSO As Object
Dim oFolder As Object
Dim oFiles As Object
Dim oFile As Object
Set oFSO = CreateObject("Scripting.FileSystemObject")
Set oFolder = oFSO.GetFolder(FolderPath)
Set oFiles = oFolder.Files
Dim v As Variant
Dim iSheet As Long
' Clear Worksheets
Dim ws As Worksheet
For Each ws In ThisWorkbook.Worksheets
ws.Cells.ClearContents
Next ws
For Each oFile In oFiles
If LCase(Right(oFile.Name, 4)) = FileExt Then
v = Split(oFile.Name, "-")
Select Case v(3)
'Setup Select to determine dept values
Case "PNT", "VLG", "SAW"
Call pvtPutOnSheet(oFile.Path, 1, v)
Case "CRT", "AST", "SHP", "SAW"
Call pvtPutOnSheet(oFile.Path, 2, v)
Case "CRT", "STW", "CHL", "ALG", "ALW", "ALF", "RTE", "AFB", "SAW"
Call pvtPutOnSheet(oFile.Path, 3, v)
Case "SCR", "THR", "WSH", "GLW", "PTR", "SAW"
Call pvtPutOnSheet(oFile.Path, 4, v)
Case "PLB", "SAW"
Call pvtPutOnSheet(oFile.Path, 5, v)
Case "DES"
Call pvtPutOnSheet(oFile.Path, 6, v)
Case "AMS"
Call pvtPutOnSheet(oFile.Path, 7, v)
Case "EST"
Call pvtPutOnSheet(oFile.Path, 8, v)
Case "PCT"
Call pvtPutOnSheet(oFile.Path, 9, v)
Case "PUR", "INV"
Call pvtPutOnSheet(oFile.Path, 10, v)
Case "SAF"
Call pvtPutOnSheet(oFile.Path, 11, v)
Case "GEN"
Call pvtPutOnSheet(oFile.Path, 12, v)
End Select
End If
Next oFile
End Sub
'Take a folder with files in it that use this naming structure: "SOP-JV-001-CHL-Letter Lock for Channel Letters-EN"
'Split up that filename using the "-" as the delimiter
'Filename[2] would go into COL A
'Filename[3] would go into COL B
'Filename[4] would go into COL C as a Hyperlink to the physical file
'Filename[5] would go into COL D
'000 11 222 333 4444444444444444444444444444444 55
'SOP-JV-001-CHL-Letter Lock for Channel Letters-EN
Private Sub pvtPutOnSheet(sPath As String, i As Long, v As Variant)
Dim r As Range
With Worksheets(i)
Set r = .Cells(.Rows.Count, 1).End(xlUp)
If Len(r.Value) > 0 Then Set r = r.Offset(1, 0) ' next empty cell in Col A
If UBound(v) > 3 Then
r.Value = v(2) ' Col A = "001"
r.Offset(0, 1).Value = v(3) ' Col B = "CHL"
'Create hyperlink in each cell
.Hyperlinks.Add Anchor:=r.Offset(0, 2), Address:=sPath, TextToDisplay:=v(4) ' Col C = "Letter Lock for Channel Letters" with link to Path
r.Offset(0, 3).Value = v(5) ' Col = "EN"
End If
End With
End Sub
Any suggestions would be welcome in all regards...