0
我的VBA功能非常有限,無法複製其他人的辛勤工作,並修改它以使其滿足需要。 我一直在尋找不同的網站和玩的選擇。我需要搜索一個網絡文件夾 - 將文件夾中的所有文件都與列A中存儲的文件編號進行匹配,並創建一個指向這些文件的超鏈接,並在A列中保留文件名。 我可以'找到我需要的和避風港無法將這些在線內容融合在一起來創建我的答案。 電子表格每週添加一個添加到現有數據的新數據,因此A列中的文件名稱數量是可變的。獲取運行時錯誤9:下標超出範圍
搜索任何文件類型/擴展名是否也可能是一個變量也可能是文件類型必須是一種類型,例如。 msg或pdf?
下面的代碼只是一個不成功的努力
Sub Hyperlinks()
'
Const sFILENAME_CELLS As String = "A2:A3200"
Const sLINKS_COLUMN As String = "A"
Const sFOLDER_NAME As String = "C:\Users\*****\Desktop\Benny PDFs"
Const sSHEET_NAME As String = "Projects"
Dim rFilenameCells As Range
Dim rFilenameCell As Range
Dim sFilename As String
Dim sFullName As String
Dim wksTarget As Worksheet
Dim iRowNo As Integer
Set wksTarget = ThisWorkbook.Sheets(sSHEET_NAME)
Set rFilenameCells = wksTarget.Range(sFILENAME_CELLS)
For Each rFilenameCell In rFilenameCells.Cells
sFilename = rFilenameCell.value
If sFilename <> vbNullString Then
sFullName = sFOLDER_NAME & "\" & sFilename
' Check that the file exists in the specified folder
If Dir$(sFullName) = sFilename Then
iRowNo = rFilenameCell.row
With wksTarget
.Hyperlinks.Add Anchor:=.Range(sLINKS_COLUMN & iRowNo), _
Address:=sFullName, _
TextToDisplay:=sFilename
End With
End If
End If
Next rFilenameCell
End Sub
你在哪一行得到錯誤9? – Rosetta
您的工作簿中可能沒有'Projects'工作表。 –