2013-10-02 78 views
1

我有一個宏已經但是我需要它也超鏈接列U中的文件與在列AExcel宏列出包含目錄中的所有文件和超鏈接他們

這裏,文件列表一起是我的代碼的權利現在,我如何添加超鏈接功能? 我不介意如果我必須添加另一個模塊。

Sub ListFilesAndSubfolders() 

    Dim FSO As Object 
    Dim rsFSO As Object 
    Dim baseFolder As Object 
    Dim file As Object 
    Dim folder As Object 
    Dim row As Integer 
    Dim name As String 

    'Get the current folder 
    Set FSO = CreateObject("scripting.filesystemobject") 
    Set baseFolder = FSO.GetFolder(ThisWorkbook.Path) 
    Set FSO = Nothing 

    'Get the row at which to insert 
    row = Range("A65536").End(xlUp).row + 1 

    'Create the recordset for sorting 
    Set rsFSO = CreateObject("ADODB.Recordset") 
    With rsFSO.Fields 
    .Append "Name", 200, 200 
    .Append "Type", 200, 200 
    End With 
    rsFSO.Open 

    ' Traverse the entire folder tree 
    TraverseFolderTree baseFolder, baseFolder, rsFSO 
    Set baseFolder = Nothing 

    'Sort by type and name 
    rsFSO.Sort = "Type ASC, Name ASC " 
    rsFSO.MoveFirst 

    'Populate the first column of the sheet 
    While Not rsFSO.EOF 
    name = rsFSO("Name").Value 
    If (name <> ThisWorkbook.name) Then 
     Cells(row, 1).Formula = name 
     row = row + 1 
    End If 
    rsFSO.MoveNext 
    Wend 

    'Close the recordset 
    rsFSO.Close 
    Set rsFSO = Nothing 

End Sub 

Private Sub TraverseFolderTree(ByVal parent As Object, ByVal node As Object, ByRef rs As Object) 

    'List all files 
    For Each file In node.Files 

    Dim name As String 
    name = Mid(file.Path, Len(parent.Path) + 2) 

    rs.AddNew 
    rs("Name") = name 
    rs("Type") = "FILE" 
    rs.Update 
    Next 

    'List all folders 
    For Each folder In node.SubFolders 
    TraverseFolderTree parent, folder, rs 
    Next 

End Sub 

即時回覆將非常受歡迎,因爲我的項目截止日期只有幾個星期了。

謝謝!

+0

查看['Worksheet.Hyperlinks.Add'](http://msdn.microsoft.com/zh-cn/library/office/ff822490.aspx)。你是否使用記錄集作爲數組替換? – Chel

回答

0

你必須給file.Path添加到您的記錄集,然後當你希望他們在您的循環鏈接嘗試這樣的事:

ActiveSheet.Hyperlinks.Add Anchor:=Cells(row, 1), Address:=file.Path, TextToDisplay:=name 

編輯

後rs.AddNew添加此行:

rs("Path") = file.Path 

再添加一個附加:

With rsFSO.Fields 
    .Append "Path", 200, 200 
    .Append "Name", 200, 200 
    .Append "Type", 200, 200 
End With 

現在改變你的這部分代碼是這樣的:

While Not rsFSO.EOF 
    name = rsFSO("Name").Value 
    path = rsFSO("Path").Value 
    If (name <> ThisWorkbook.name) Then 
     ActiveSheet.Hyperlinks.Add Anchor:=Cells(row, 1), Address:=path, TextToDisplay:=name 
     row = row + 1 
    End If 
    rsFSO.MoveNext 
    Wend 

您可能需要在你的代碼是這樣的頂部添加定義:

dim path as string 
+0

我在哪裏可以將這段代碼放在前面的代碼中,對於VB來說很抱歉。 –

+0

看到我上面的編輯,你將不得不改變幾個不同的部分。讓我知道你得到的錯誤和他們來自哪條線。 –

+0

做了你所說的一切,我得到了運行時「3265」 項目找不到對應於請求名稱或序號的集合 突出顯示rs(「Path」)= file.Path之後rs.addnew –

相關問題