2016-04-05 114 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文件名将会超链接到文件替换。

相关问题