Adding links of files, seperating filenames with Split() - Error: Object variable or

[mongoose]

I'm making a program that does many different tasks and using it as an opportunity to get more familiar with VBA. Right now, this code is in a separate file until I get the foundation of the code solid then I'll migrate the changes to the actual file it is meant for.


To sum up what I am trying to do:


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


Here's my code so far that is giving me the error: "Object variable or With block variable not set"


Sub GenerateFileLinks()
Dim objFSO As Object
Dim objFolder As Object
Dim objFile As Object
Dim i As Integer

'Create an instance of the FileSystemObject
Set objFSO = CreateObject("Scripting.FileSystemObject")

'Get the folder object
Set objFolder = objFSO.GetFolder("C:\Users\jbishop\Desktop\SOPs With New Names")

i = 1

Dim rngSOPID As Range
Dim rngDeptCode As Range
Dim rngURL As Range
Dim rngLang As Range
'Loop through each file in the directory
For Each objFile In objFolder.Files
'SOP ID Range
rngSOPID = Range(Cells(i + 1, 1), Cells(i + 1, 1)).Select
'DeptCode Range
rngDeptCode = Range(Cells(i + 1, 2), Cells(i + 1, 2)).Select
'URL Range
rngURL = Range(Cells(i + 1, 3), Cells(i + 1, 3)).Select
'Lang Range
rngLang = Range(Cells(i + 1, 4), Cells(i + 1, 4)).Select

'Create hyperlink in each cell
ActiveSheet.Hyperlinks.Add Anchor:=rngURL, Address:=objFile.Path, TextToDisplay:=objFile.Name

i = i + 1
Next objFile
End Sub



I know it's the "...Anchor:=rngURL" but I just don't know why.
Thanks for all of your help.

[Paul_Hossler]

Quick look …

1. Range variables need 'Set rngSOPID = ...'

2. Not .Select





For Each objFile In objFolder.Files

'SOP ID Range
Set rngSOPID = Range(Cells(i + 1, 1), Cells(i + 1, 1))

'DeptCode Range
Set rngDeptCode = Range(Cells(i + 1, 2), Cells(i + 1, 2))

'URL Range
Set rngURL = Range(Cells(i + 1, 3), Cells(i + 1, 3))

'Lang Range
Set rngLang = Range(Cells(i + 1, 4), Cells(i + 1, 4))

'Create hyperlink in each cell
ActiveSheet.Hyperlinks.Add Anchor:=rngURL, Address:=objFile.Path, TextToDisplay:=objFile.Name

i = i + 1
Next objFile

[mongoose]

Yes! I just figured that out before reading your reply! Thanks...here's my code now...


Sub GenerateFileLinks()
ActiveSheet.Cells.Clear

Dim objFSO As Object
Dim objFolder As Object
Dim objFile As Object
Dim i As Integer

'Create an instance of the FileSystemObject
Set objFSO = CreateObject("Scripting.FileSystemObject")

'Get the folder object
Set objFolder = objFSO.GetFolder("C:\Users\jbishop\Desktop\SOPs With New Names")

i = 1

'Loop through each file in the directory
For Each objFile In objFolder.Files
'SOP ID Range
Set rngSOPID = Range(Cells(i + 1, 1), Cells(i + 1, 1))
'DeptCode Range
Set rngDeptCode = Range(Cells(i + 1, 2), Cells(i + 1, 2))
'URL Range
Set rngURL = Range(Cells(i + 1, 3), Cells(i + 1, 3))
'Lang Range
Set rngLang = Range(Cells(i + 1, 4), Cells(i + 1, 4))

'Create hyperlink in each cell
ActiveSheet.Hyperlinks.Add Anchor:=rngURL, Address:=objFile.Path, TextToDisplay:=objFile.Name

i = i + 1
Next objFile
End Sub


I got rid of the error with the changes above. For some reason the links are starting to be entered at C2 instead of C1 now though, which before it was going into C1. If I change i=0 it goes into C1, but that shouldn't be the case, right?

[mongoose]

Here's my new code..



Sub GenerateFileLinks()
ActiveSheet.Cells.Clear

Dim objFSO As Object
Dim objFolder As Object
Dim objFile As Object


Set objFSO = CreateObject("Scripting.FileSystemObject")
Set objFolder = objFSO.GetFolder("C:\Users\jbishop\Desktop\SOPs With New Names")


Dim i As Long: i = 1


For Each objFile In objFolder.Files
With Worksheets(1)
'.Cells(i, 1) = objFile
If UBound(Split(objFile, "-")) > 3 Then
.Cells(i, 1) = Split(objFile.Name, "-")(2)
.Cells(i, 2) = Split(objFile.Name, "-")(3)
.Cells(i, 3) = Split(objFile.Name, "-")(4)
.Add Anchor....
.Cells(i, 4) = Split(objFile.Name, "-")(5)
End If
End With
i = i + 1
Next objFile
End Sub




Isn't there a way to add the link like I have above? with .Add Anchor referring to the Cells on that line?

[Paul_Hossler]

Not sure, but try this




'Create hyperlink in each cell
ActiveSheet.Hyperlinks.Add Anchor:=.Cells(I, 4), Address:=objFile.Path, TextToDisplay:=objFile.Name

[mongoose]

Ok, so I got that to work...here's the code.


Sub GenerateFileLinks()
ActiveSheet.Cells.Clear

Dim objFSO As Object
Dim objFolder As Object
Dim objFile As Object




Set objFSO = CreateObject("Scripting.FileSystemObject")
'Get the folder object
'Set objFolder = objFSO.GetFolder("C:\Users\jbishop\Desktop\SOPs With New Names")
Set objFolder = objFSO.GetFolder("\\jacksonville-dc\common\Jonathan Bishop\SOPs With New Names")


Dim i As Long: i = 1




For Each objFile In objFolder.Files
With Worksheets(1)
'.Cells(i, 1) = objFile
If UBound(Split(objFile, "-")) > 3 Then
.Cells(i, 1) = Split(objFile.Name, "-")(2)
.Cells(i, 2) = Split(objFile.Name, "-")(3)
'Create hyperlink in each cell
ActiveSheet.Hyperlinks.Add Anchor:=.Cells(i, 3), Address:=objFile.Path, TextToDisplay:=Split(objFile.Name, "-")(4)
.Cells(i, 4) = Split(objFile.Name, "-")(5)
End If
End With
i = i + 1
Next objFile
End Sub


I need to combine that with this code...


Option Explicit


Private Sub Workbook_Open()


' Set local folder path
Const FolderPath As String = "\\jacksonville-dc\common\Jonathan Bishop\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.Name, 1)

Case "CRT", "AST", "SHP", "SAW"
Call pvtPutOnSheet(oFile.Name, 2)

Case "CRT", "STW", "CHL", "ALG", "ALW", "ALF", "RTE", "AFB", "SAW"
Call pvtPutOnSheet(oFile.Name, 3)

Case "SCR", "THR", "WSH", "GLW", "PTR", "SAW"
Call pvtPutOnSheet(oFile.Name, 4)

Case "PLB", "SAW"
Call pvtPutOnSheet(oFile.Name, 5)

Case "DES"
Call pvtPutOnSheet(oFile.Name, 6)

Case "AMS"
Call pvtPutOnSheet(oFile.Name, 7)

Case "EST"
Call pvtPutOnSheet(oFile.Name, 8)

Case "PCT"
Call pvtPutOnSheet(oFile.Name, 9)

Case "PUR", "INV"
Call pvtPutOnSheet(oFile.Name, 10)

Case "SAF"
Call pvtPutOnSheet(oFile.Name, 11)

Case "GEN"
Call pvtPutOnSheet(oFile.Name, 12)
End Select
End If
Next oFile
End Sub


Private Sub pvtPutOnSheet(s As String, i As Long)
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)

r.Value = s
End With
End Sub



Any suggestions on how to proceed? Should I just add this section of code to every case in the Select statement?

With Worksheets(1)
'.Cells(i, 1) = objFile
If UBound(Split(objFile, "-")) > 3 Then
.Cells(i, 1) = Split(objFile.Name, "-")(2)
.Cells(i, 2) = Split(objFile.Name, "-")(3)
'Create hyperlink in each cell
ActiveSheet.Hyperlinks.Add Anchor:=.Cells(i, 3), Address:=objFile.Path, TextToDisplay:=Split(objFile.Name, "-")(4)
.Cells(i, 4) = Split(objFile.Name, "-")(5)
End If
End With

[Paul_Hossler]

I think you could make the pvtPutOnSheet sub smarter and pass the path and the array after Split() to it




Option Explicit



Private Sub Workbook_Open()
' Set local folder path
Const FolderPath As String = "\\jacksonville-dc\common\Jonathan Bishop\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

[mongoose]

Wow, okay it works great. I have some other functionality I need to add to it. I need to do a little bit of planning and thinking about first.

Before that, I really need to look up a few things in your code to make sure I completely understand what you are doing.

Thank you very much. Slowly on the road to being able to write and understand VBA like I can other languages.