【VBA】セルをクリックしてファイルを開く

エクセルのセルをクリックすると、任意のファイルを開くことができるVBAを紹介します。

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

セルをクリックたらファイルを開くマクロを実行する

セルをクリックをしたらファイルを開くVBA

Private Sub Worksheet_SelectionChange(ByVal Target As Range)

If Target.Column = 1 Then
    Call 検索_Click
End If

End Sub

クリックをしたらファイルを開くVBAの解説

A列を変更したら、「検索_clickマクロ」を起動する

会社名でファイル名検索をしたい場合は「Target.Column = 2」としB列を指定

ただし、データを追加したときや、カーソルが該当列に行ったときもファイル検索を開始してしまうので、次のように追加をするとよい。

Dim ans As Long

If Target.Column = 1 Then
    ans = MsgBox(“検索しますか”, vbYesNo)
    If ans = vbNo Then
        End
    End If
    Call 検索_Click
End If

A列が変更されたら
メッセージボックスを表示する。
「No」が選択された場合、終了する
「Yes]が選択された場合、「検索_clickマクロ」を起動する

セルクリックからの検索ではなく、InputBoxを使った入力ボックス付きのダアログボックスから検索する方法も考えられる。

ファイルを開くVBA

ファイルを開くVBA

Sub 検索_Click()

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 cnt As Long, i, x 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)

x = ActiveCell.Value
For i = 0 To cnt – 1
    If FileList(i) Like “” & x & “” Then
        CreateObject(“Shell.Application”).ShellExecute FileList(i)
    End If
Next i

Erase FileList

End Sub

ファイルを開くVBAの解説

x = クリックしたセル（アクティブセル）の値

もしフルパスが「x」を含むファイル名であれば
エクセルを含む、ファイルそれぞれに設定されたアプリケーションで開く

FileListを空にする

B列の会社名でファイル検索をする場合は、xをstringで宣言する

ファイル名がそれぞれユニークな取引先コードである場合

x = ActiveCell.Value
For i = 0 To cnt – 1
    If FileList(i) Like “” & x & “” Then
        CreateObject(“Shell.Application”).ShellExecute FileList(i)
        GoTo Re:
    End If
Next i

Erase FileList

Re:

End Sub

として「For～Next」の繰り返しを離脱できる。

該当するファイルが存在しない場合

メッセージを表示するならば、「Dim n As Long」を宣言し、

x = ActiveCell.Value
n = 0
For i = 0 To cnt – 1
    If FileList(i) Like “” & x & “” Then
        CreateObject(“Shell.Application”).ShellExecute FileList(i)
        n = n + 1
    End If
Next i

If n = 0 Then
    MsgBox x & ” 該当するファイルがありません”
End If

会社名で検索する場合、全角と半角を区別しない（xとファイル名を全角で揃えて比較）

x = StrConv(ActiveCell.Value, vbWide)
For i = 0 To cnt – 1
    If StrConv(FileList(i), vbWide) Like “” & x & “” Then
        CreateObject(“Shell.Application”).ShellExecute FileList(i)
    End If
Next i

半角で揃えたい場合は、「vbWide」を「vbNarrow」とする。