fc2ブログ

カテゴリー

リンク

最近の記事

最近のコメント

最近のトラックバック

カレンダー

02 | 2010/03 | 04
- 1 2 3 4 5 6
7 8 9 10 11 12 13
14 15 16 17 18 19 20
21 22 23 24 25 26 27
28 29 30 31 - - -

過去のログ

Plug-in by
@激安・割安・おすすめ商品@

RSSフィード

EXCEL VBA で指定したフォルダのファイル名一覧

 

EXCELで指定したフォルダのファイル名一覧をセルに入力するVBAを作成したのでメモしておきます。
以下のサイトを参考にしましたというか、コピペです。

 

http://www.asahi-net.or.jp/~ef2o-inue/vba_o/sub05_110_080.html
http://officetanaka.net/excel/vba/tips/tips39.htm

 

動きとしては、フォルダを指定するダイヤログボックスが起動し、指定したら、そのフォルダのファイル名一覧をA列のセルに入力します。

 

以下がソースです。

 

Sub Display_Directory()
    Const cnsDIR = "\*.*"
    Dim xlAPP As Application
    Dim strPATHNAME As String
    Dim strFILENAME As String
    Dim GYO As Long
   
    Cells.Select
    Selection.ClearContents
    Range("A1").Select
   
    Set xlAPP = Application
    With Application.FileDialog(msoFileDialogFolderPicker)
        If .Show = True Then
            MsgBox .SelectedItems(1) & " のファイル一覧を取得します。"
            strPATHNAME = .SelectedItems(1)
        End If
    End With
   
    If StrConv(strPATHNAME, vbUpperCase) = "FALSE" Then Exit Sub
    ' フォルダの存在確認
    If Dir(strPATHNAME, vbDirectory) = "" Then
        MsgBox "指定のフォルダは存在しません。"
        Exit Sub
    End If

    ' 先頭のファイル名の取得
    strFILENAME = Dir(strPATHNAME & cnsDIR, vbNormal)
    ' ファイルが見つからなくなるまで繰り返す
    Do While strFILENAME <> ""
        ' 行を加算
        GYO = GYO + 1       ' 先頭は1行目
        Cells(GYO, 1).Value = strFILENAME
        ' 次のファイル名を取得
        strFILENAME = Dir()
    Loop
   
    MsgBox "完了"
End Sub

 

スポンサーサイト



 BLOG TOP