2016-04-05 119 views
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 
+0

你在哪一行得到錯誤9? – Rosetta

+0

您的工作簿中可能沒有'Projects'工作表。 –

回答

0

獲取運行時錯誤9:下標越界

的原因可能是你沒有Projects片在工作簿。 也改變這一行:

Const sLINKS_COLUMN  As String = "A" 

別的東西,然後A,因爲像這樣的A2:A3200文件名將會超鏈接到文件替換。

相關問題