フォルダ名とファイル名とセルの値を取得しハイパーリンクで開く

フォルダ名とファイル名とセルの値を検索. Excel VBA すべて
2024.04.13

複数のフォルダーの中にあるエクセルのファイルを検索してフォルダ名、ファイル名、セルの値をエクセルのシートに表示します。

フォルダ名はエクセルシートのセルA2から下に、ファイル名はセルB2から下に、セルの値はC2から下に表示されます、表示されたファイル名をクリックするとファイルを開くことができます。

Sub フォルダ名とファイル名とセルの値を検索()

   Dim file_name As String
   Dim folder_name(12) As String  '12個の配列要素の宣言をします
    
   folder_name(0) = ThisWorkbook.Path & "\フォルダ1\"
   folder_name(1) = ThisWorkbook.Path & "\フォルダ2\"
   folder_name(2) = ThisWorkbook.Path & "\フォルダ3\"
   folder_name(3) = ThisWorkbook.Path & "\フォルダ4\"
   folder_name(4) = ThisWorkbook.Path & "\フォルダ5\"
   folder_name(5) = ThisWorkbook.Path & "\フォルダ6\"
   folder_name(6) = ThisWorkbook.Path & "\フォルダ7\"
   folder_name(7) = ThisWorkbook.Path & "\フォルダ8\"
   folder_name(8) = ThisWorkbook.Path & "\フォルダ9\"
   folder_name(9) = ThisWorkbook.Path & "\フォルダ10\"
   folder_name(10) = ThisWorkbook.Path & "\フォルダ11\"
   folder_name(11) = ThisWorkbook.Path & "\フォルダ12\"
    
   Dim i As Integer
   Dim Q As Integer
    
   i = 0   '変数iを0にしてフォルダ名(folder_name)を初期値にします。
        
   For Q = 1 To 12  'For..Nextステートメントで12回繰り返します。
    
      file_name = Dir(folder_name(i) & "*.xlsx")  'Dir関数で検索します。
    
         Do While file_name <> ""  'フォルダ内にエクセルのファイルが見つかる間は処理を行います。
    
            Workbooks.Open folder_name(i) & file_name  'ファイルを開きます。
             
            With ThisWorkbook.Worksheets("Sheet1").Cells(Rows.Count, 1).End(xlUp) 'セルの最終行取得
                
               .Offset(1, 0).Value = Mid(ActiveWorkbook.Path, InStrRev(ActiveWorkbook.Path, "\") + 1)
               .Hyperlinks.Add Anchor:=.Offset(1, 1), Address:=folder_name(i) & file_name, TextToDisplay:=file_name
               .Offset(1, 2).Value = Workbooks(file_name).Worksheets("Sheet1").Range("A1").Value
          
            End With
          
            Workbooks(file_name).Close savechanges:=False  'ファイルを閉じます。
        
            file_name = Dir()
        
         Loop
    
   i = i + 1  'iの値を1つずつ増やしてフォルダ名(folder_name)を0～11まで変えていきます。
    
   Next Q
    
End Sub

フォルダまでのフルパスをA2セルから下に表示したいときは上のプログラムの下から10行目の.Offset(1, 0).Value = Mid(ActiveWorkbook.Path, InStrRev(ActiveWorkbook.Path, “\”) + 1)を.Offset(1, 0).Value = ActiveWorkbook.Pathに変えれば表示することができます。

ThisWorkbook.Pathでファイルパスを取得しているのでファイル検索するフォルダはマクロを実行するブックと同じフォルダに入れて下さい。

With ThisWorkbook.Worksheets("Sheet1").Cells(Rows.Count, 1).End(xlUp) 'セルの最終行取得
                
    .Offset(1, 0).Value = Mid(ActiveWorkbook.Path, InStrRev(ActiveWorkbook.Path, "\") + 1)
    .Hyperlinks.Add Anchor:=.Offset(1, 1), Address:=folder_name(i) & file_name, TextToDisplay:=file_name
    .Offset(1, 2).Value = Workbooks(file_name).Worksheets("Sheet1").Range("A1").Value
          
End With

上のWithステートメント内のコードの記述を自分なりにアレンジすればセルにいろいろなデータを表示すること出来るのでご活用ください。

コメント