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

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

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

ファイル名の一覧を取得したのはいいのですが、その一覧から直接ファイルにアクセスしたいです。

わかりました。それではハイパーリンクをつけましょう。WEBのURLやメールアドレスに下線が付いて青くなる、あれです。

下線のついた文字をクリックするとファイルが開くということですね。

前回のマクロにハイパーリンクの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 ハイパーリンクに表示する文字列:ファイル名

オートフィルタなどを使えばさらに詳細に絞り込むことが出来ますね。

この記事が気に入ったら
フォローしてね!

よかったらシェアしてね!

この記事を書いた人

子育てに奮闘しながらも、再びガッツリ走り込める日を夢見るフルタイム会社員。

コメント

コメントする

CAPTCHA


目次
閉じる