excel vbaでハイパーリンクを設定するには

質問

お世話様です。
Excecl2000での質問です。
C:の中に「SAISYO」というフォルダがあります。
この「SAISYO」の中には「TUGI」というフォルダや「ファイル1」というファイルがあります。
そして「TUGI」の中には「SONOTUGI」というフォルダや「ファイル2」というファイルがあります。
やりたいことは、Sheet1にあるボタンをクリックすると「SAISYO」の中のすべてのファイルのパスをハイパーリンク形式でA1.A2.A3・・・のセルに書き出したいんです。
最終的には書き加えたいことがあるので、ソフトの使用ではなくコードが知りたいのです。

色々試したのですがフォルダの中のフォルダの中のファイルのパスの取得とハイパーリンク形式で、というところがどうしてもわかりません。お詳しい方是非教えてください。

よろしくお願いします。

回答No.1

nicotinism · ベストアンサー

ハイパーリンクの設定はマクロの記録で出来るかと思いますけど・・・

こんな感じで如何でしょ
ListUp を実行して下さい

Function GetSubDir(strTrgDir As String, Optional rRow As Integer) As Boolean
　　Dim objFs As Object
　　Dim objDir As Object
　　Dim objFile As Object

　　On Error GoTo errHnd
　　Set objFs = CreateObject("Scripting.FileSystemObject")
　　Set objDir = objFs.Getfolder(strTrgDir)
　　Set objFile = objDir.Files

　　For Each objFile In objDir.Files
　　　　rRow = rRow + 1
　　　　'Debug.Print "rRow = " & rRow, "file = " & objFile.Path
　　　　Worksheets("sheet1").Hyperlinks.Add _
　　　　Anchor:=Cells(rRow, 1), _
　　　　Address:=objFile.Path, _
　　　　TextToDisplay:=objFile.Path
　　Next

　　For Each objDir In objDir.subfolders
　　　　Call GetSubDir(objDir.Path, rRow) '←サブフォルダを見に行きます
　　Next

　　Set objFs = Nothing
　　Set objDir = Nothing
　　GetSubDir = True
　　Exit Function
errHnd:
　　Debug.Print Err.Number, Err.Description
End Function

Sub ListUp()
　　MsgBox IIf(GetSubDir("c:\saisyo") = True, "成功", "失敗")
End Sub

お礼

出来ました。
私などには書けないすばらしいコードに感激です。
nicotinismさんのような完璧なコードは書けるようにがんばります。
本当に助かりました。ありがとうございました。