【VBA】取得したファイル名一覧にハイパーリンクをつける

 マクロで取得したファイル名一覧に、それぞれハイパーリンクをつけ、クリックをしたらそのファイルが開くように出来るVBAを紹介します。

前回は、特定のフォルダを検索してファイル名の一覧を表示するマクロを紹介しました。

ファイル名一覧を取得し、ハイパーリンクをつけるVBA

ファイル名を取得するところまでは一緒です。

エクセルに一覧表示するものを「フルパス」に変更して進めています。

Sub ファイル名取得()

Const SEARCH_DIR As String = “C:¥Users¥¥フォルダ名”
Const SEARCH_FILE As String = “.csv”
Dim tmpFile As String
Dim strCmd As String
Dim buf() As Byte
Dim FileList() As String
Dim myArray() As String
Dim cnt As Long, pt As Long, e , i As Long

tmpFile = Environ(“TEMP”) & “¥Dir.tmp”

strCmd = “Dir “”” & SEARCH_DIR & “¥” & SEARCH_FILE & _
         “”” /b/s/a:-d > “”” & tmpFile & “”””

With CreateObject(“Wscript.Shell”)
    .Run “cmd /c” & strCmd, 7, True
End With

If FileLen(tmpFile) < 1 Then
    MsgBox “該当するファイルがありません”
    Exit Sub
End If

Open tmpFile For Binary As #1
    ReDim buf(1 To LOF(1))
    Get #1, , buf
Close #1
Kill tmpFile

FileList() = Split(StrConv(buf, vbUnicode), vbCrLf)

cnt = UBound(FileList)

ReDim myArray(1 To cnt)
For i = 1 To cnt
    pt = InStrRev(FileList(i – 1), “¥”)
    myArray(i) = Mid(FileList(i – 1), pt + 1)
Next i

Sheets(“ファイル名”).Select
Cells.ClearContents
Range(“A1”).Value = “フルパス”
Range(“A2”).Resize(cnt, 1).Value = WorksheetFunction.Transpose(FileList)

e = Cells(Rows.Count, 1).End(xlUp).Row

With Sheets(“ファイル名”).Hyperlinks
    For i = 2 To e
        .Add Anchor:=Cells(i, 2), Address:=Cells(i, 1), TextToDisplay:=myArray(i – 1, 1)
    Next i
End With

End Sub

ハイパーリンクをつけるVBAの解説

シート「フォルダ名」においてハイパーリンクをつける
Anchor　ハイパーリンクを設定するセル：B列
Address　接続先（ファイルパスなど）：A列
TextToDisplay　ハイパーリンクに表示する文字列：ファイル名