見出し画像

指定したフォルダのファイルパスを書き出す

ダイアログボックスで選択したフォルダのファイルパスを一気に書き出す

Sub GetFilesofDirectory()
   Const filesDirectory = "\*.*"
   Dim strDirectory As String, strPathName As String
   Dim myArray As Variant, i As Integer, PasteRange As Range
   With Application.FileDialog(msoFileDialogFolderPicker)
       If .Show = True Then
           strDirectory = .SelectedItems(1)
       End If
   End With
   If strDirectory = "" Then Exit Sub
   strPathName = Dir(strDirectory & filesDirectory, vbNormal)
   i = 0
   ReDim myArray(i)
   Do While strPathName <> "" ' ファイルが見つからなくなるまでLoop
       myArray(i) = strPathName
       strPathName = Dir()
       If strPathName <> "" Then
           i = i + 1
           ReDim Preserve myArray(i)
       End If
   Loop
   myArray = WorksheetFunction.Transpose(myArray) '縦方向の二次元配列に変換
   With ActiveWorkbook.ActiveSheet
       Set PasteRange = .Range(.Cells(ActiveCell.Row, ActiveCell.Column), .Cells(ActiveCell.Row + i, ActiveCell.Column))
       If WorksheetFunction.CountBlank(PasteRange) = i Then Exit Sub
       PasteRange = myArray
   End With
   Set PasteRange = Nothing
End Sub

「なんに使うの?」って声、あるかもなー。って思いますがこれのポイントはファイルパスの取得の方法がみそかなと。Dir関数はホント特徴的な関数です。応用できれば・・・VBAの幅もメチャ広がります。

あとは配列の扱いですね。Dir関数でmyArrayって配列にひたすらパスをつっこんでいるところにこれで二次元配列に一発変換しているVBAならではの出鱈目さを訴えたいですw

myArray = WorksheetFunction.Transpose(myArray) '縦方向の二次元配列に変換

ちなみにこれやらないと範囲に上手くファイルパスを列挙できません。ファイルパスじゃなくてファイル名でも全部行けるし、応用すればファイルを全部開くなんてこともできますよ。

応用の可能性が大!だから載せました

Dir関数を使って指定フォルダのファイルを全部書き出すって実は私人生でかなり使ってます。ファイルの一括リネームや移動とか・・・とにかく可能性が広がるのよ。使ってみそ。

有意義なコードもうちょっと考えます・・・


この記事が気に入ったらサポートをしてみませんか?