none
アクセスでサブフォルダ以下にあるファイルもすべてインポートする方法 RRS feed

  • 質問

  • VBAはかじった程度の初心者です。

    アクセスで、指定フォルダの中のサブフォルダが多数あります。それらサブフォルダの中のcsvファイルを一括でインポートしたいと思っています。csvファイルのカラム構成はすべて共通です。

    web検索で調べ出てきたVBAの書き方

    (1)フォルダ内ファイルをまとめてインポートする書き方(TransferText)

    (2)フォルダ内のすべてのサブフォルダにあるファイルを検索する(FileSystemObject)

    を文法などよくわからないなりに組み合わせて、以下のVBAを書いてみましたが、エラーで止まってしまいます。

    ++++

         

    Sub Dataimport()
        Call FileSearch("D:\Dataimporttest")
    End Sub

    Sub FileSearch(Path As String)
        Dim FSO As Object, Folder As Variant, File As Variant
        Set FSO = CreateObject("Scripting.FileSystemObject")
        For Each Folder In FSO.GetFolder(Path).SubFolders
            Call FileSearch(Folder.Path)
        Next Folder
        For Each File In FSO.GetFolder(Path).Files
            DoCmd.TransferText acImportDelim, , "All_data", Path & "\*.csv", True
        Next File

     End Sub

    +++++

    エラーは「TransferText」のコマンドの行で発生します。エラー文章は

    「実行時エラー'3011':オブジェクト'*.csv'が見つかりませんでした。オブジェクトが存在していること、名前やパス名が正しいことを確認してください。」

    と出ます。

    ローカルウィンドウで確認すると、「Path」の値には検索すべきサブフォルダが表示されているので、そこまではうまく言っていると思うのですが、その先、何がだめなのかわかりません。ワイルドカードも使えるはずなのに・・・?

    ご指南いただけますよう、お願い申し上げます。

    2016年12月28日 4:29

回答

  • 2番目のFor Each文の変数Fileにはサーチされたファイルのパスが格納されるので、If文でCSVかどうかの判定を行いTransferTextへパスFileをそのままわたすとよいと思います。

    Sub Dataimport()
        Call FileSearch("D:\Dataimporttest")
    End Sub
    
    Sub FileSearch(Path As String)
        Dim FSO As Object, Folder As Variant, File As Variant
        Set FSO = CreateObject("Scripting.FileSystemObject")
        For Each Folder In FSO.GetFolder(Path).SubFolders
            Call FileSearch(Folder.Path)
        Next Folder
        For Each File In FSO.GetFolder(Path).Files
            If File.Name Like "*.csv" Then
                DoCmd.TransferText acImportDelim, , "All_data", File, True
            End If
        Next File
     End Sub

    参考サイト: http://officetanaka.net/excel/vba/tips/tips36.htm
    2016年12月28日 4:49

すべての返信

  • 2番目のFor Each文の変数Fileにはサーチされたファイルのパスが格納されるので、If文でCSVかどうかの判定を行いTransferTextへパスFileをそのままわたすとよいと思います。

    Sub Dataimport()
        Call FileSearch("D:\Dataimporttest")
    End Sub
    
    Sub FileSearch(Path As String)
        Dim FSO As Object, Folder As Variant, File As Variant
        Set FSO = CreateObject("Scripting.FileSystemObject")
        For Each Folder In FSO.GetFolder(Path).SubFolders
            Call FileSearch(Folder.Path)
        Next Folder
        For Each File In FSO.GetFolder(Path).Files
            If File.Name Like "*.csv" Then
                DoCmd.TransferText acImportDelim, , "All_data", File, True
            End If
        Next File
     End Sub

    参考サイト: http://officetanaka.net/excel/vba/tips/tips36.htm
    2016年12月28日 4:49
  • kenjinote様

    さっそくのご回答、誠にありがとうございました。

    無事に動作いたしました。なるほど、と大変勉強になりました。

    重ねて、重ねて感謝申し上げます。


    2016年12月28日 6:14