none
【AccessVBA】テキストファイルの中身をテーブルに入れることはできますか。 RRS feed

  • 質問

  • VBAに手を出し始めて間もないのですがご教示をお願いします。

    テキストファイルの中身を特定のテーブルのフィールドに書き込むことは可能でしょうか。

    フォルダパスとファイル名を取得してファイル名と同じテキストファイルを同じレコードの別フィールドに書き込もうと考えています。

    なお、テキストファイルには改行も含まれています。

    以下のようなテーブルイメージです。

    フォルダパス    ファイル名     テキストファイル

    C:\Temp            |    test.accdb      |         abcdefg                | ←テキストファイルのフィールドにはtest.txtの中身が出力される

    C:\Temp            |    test2.accdb     |         111222                | ←テキストファイルのフィールドにはtest2.txtの中身が出力される

    ご存知の方がいらっしゃいましたら、ご教示いただけますと幸いです。

    2019年5月29日 11:38

回答

  • フォルダパス    ファイル名     テキストファイル

    C:\Temp            |    test.accdb      |         abcdefg                | ←テキストファイルのフィールドにはtest.txtの中身が出力される

    C:\Temp            |    test2.accdb     |         111222                | ←テキストファイルのフィールドにはtest2.txtの中身が出力される

    質問文では『ファイル名と同じテキストファイル』と書かれていますが…

    [ファイル名] フィールドにある名前は test.accdb / test2.accdb であるのに対し、
    読み取りたいテキストファイルは test.txt / test2.txt ということで
    ファイル名の拡張子が違っているように見受けられます。

    テキストファイル名を決定するために、[ファイル名] フィールドの拡張子を
    .accdb から .txt に変更する必要があるのでしょうか。

    Option Compare Database
    Option Explicit
    
    Public Sub Example_Start()
        If MsgBox("実験用テーブルを作成しますか?", vbQuestion Or vbYesNo) = vbYes Then
            CreateDemoData
        End If
        
        Dim fso As Object  ' As Scripting.FileSystemObject
        Set fso = CreateObject("Scripting.FileSystemObject")
        
       
        MsgBox "txt ファイルの内容をテーブル内に書き込みます", vbInformation
        Const adCmdTableDirect As Long = 512
        Const adLockOptimistic As Long = 3
        Dim conn As Object ' As ADODB.Connection
        Set conn = CurrentProject.Connection
        
        conn.BeginTrans
        
        Dim txtPath As String
        Dim rs As Object  ' As ADODB.Recordset
        Set rs = CreateObject("ADODB.Recordset")
        rs.LockType = adLockOptimistic
        rs.Open "テキストデータ", conn, Options:=adCmdTableDirect
        Do Until rs.EOF
            txtPath = fso.BuildPath(rs.Fields("フォルダパス").Value, _
                fso.GetBaseName(rs.Fields("ファイル名").Value) & ".txt")
            
            If fso.FileExists(txtPath) Then
                Debug.Print "ファイルを読み取ります。", txtPath
                rs.Update "テキストファイル", ReadAllText(txtPath, "Shift_JIS")
            Else
                Debug.Print "ファイルが見つかりません。", txtPath
                rs.Update "テキストファイル", Null
            End If
            
            rs.MoveNext
        Loop
        rs.Close
    
        conn.CommitTrans
        
        MsgBox "書き換えが完了しました", vbInformation
    End Sub
    
    
    Private Sub CreateDemoData()
        Dim conn As Object ' As ADODB.Connection
        Set conn = CurrentProject.Connection
        
        Dim sql As String
        
        sql = "CREATE TABLE [テキストデータ]" & vbCrLf _
            & "( ID COUNTER(10000, 10) PRIMARY KEY" & vbCrLf _
            & ", [フォルダパス] NVARCHAR(255) NOT NULL" & vbCrLf _
            & ", [ファイル名] NVARCHAR(255) NOT NULL" & vbCrLf _
            & ", [テキストファイル] LONGTEXT NULL" & vbCrLf _
            & ")"
        conn.Execute sql
    
    '    sql = "CREATE TABLE [バイナリデータ]" & vbCrLf _
    '        & "( ID COUNTER(10000, 10) CONSTRAINT ID PRIMARY KEY" & vbCrLf _
    '        & ", [フォルダパス] NVARCHAR(255) NOT NULL" & vbCrLf _
    '        & ", [ファイル名] NVARCHAR(255) NOT NULL" & vbCrLf _
    '        & ", [バイナリファイル] BINARY NULL" & vbCrLf _
    '        & ")"
    '    conn.Execute sql
    
        Application.RefreshDatabaseWindow
        conn.BeginTrans
    
        sql = "INSERT INTO [テキストデータ]" & vbCrLf _
            & "( [フォルダパス], [ファイル名], [テキストファイル] ) " & vbCrLf _
            & "VALUES ( FolderPath, FileName, Contents )"
        
        Dim cmd As Object  ' As ADODB.Command
        Set cmd = CreateObject("ADODB.Command")
        Set cmd.ActiveConnection = CurrentProject.Connection
        cmd.CommandText = sql
        cmd.Parameters.Refresh
        
        cmd!FolderPath.Value = "C:\Temp"
        cmd!fileName.Value = "test.accdb"
        cmd!Contents.Value = Null
        cmd.Execute
        
        cmd!FolderPath.Value = "C:\Temp"
        cmd!fileName.Value = "test2.accdb"
        cmd!Contents.Value = Null
        cmd.Execute
        
        cmd!FolderPath.Value = "C:\Program Files\dotnet"
        cmd!fileName.Value = "LICENSE.txt"
        cmd!Contents.Value = Null
        cmd.Execute
       
        conn.CommitTrans
    End Sub
    
    '第1引数:テキストファイルのフルパス
    '第2引数:テキストファイルの文字コード("Shift_JIS" とか "UTF-16" とか "UTF-8" とか)、省略時は自動判定
    Public Function ReadAllText(ByVal targetFilePath As String, Optional characterSet As Variant) As String
        Const adTypeText As Long = 2
        Const adReadAll As Long = -1
        Dim stm As Object  ' As ADODB.Stream
        Set stm = CreateObject("ADODB.Stream")
        stm.Type = adTypeText
        stm.Charset = IIf(IsMissing(characterSet), "_autodetect_all", characterSet)
        stm.Open
        stm.LoadFromFile targetFilePath
        ReadAllText = stm.ReadText(adReadAll)
        stm.Close
    End Function
    
    'Public Function ReadAllBytes(ByVal targetFilePath As String) As Byte()
    '    Const adTypeBinary As Long = 1
    '    Const adReadAll As Long = -1
    '    Dim stm As Object  ' As ADODB.Stream
    '    Set stm = CreateObject("ADODB.Stream")
    '    stm.Type = adTypeBinary
    '    stm.Open
    '    stm.LoadFromFile targetFilePath
    '    ReadAllBytes = stm.Read(adReadAll)
    '    stm.Close
    'End Function
    '


    • 編集済み 魔界の仮面弁士MVP 2019年5月31日 5:44 コードに説明コメント追加
    • 回答としてマーク optivue 2019年6月3日 10:42
    • 回答としてマークされていない optivue 2019年6月3日 10:43
    • 回答としてマーク optivue 2019年6月3日 10:43
    2019年5月31日 1:52

すべての返信

  • optivueさん、こんばんは。

    テキストファイルの中身を特定のテーブルのフィールドに書き込むことは可能です。インターネット上の情報を検索すれば、必要な情報は入手できると思います。

    これ以上のことは、何をどうしたいのか、具体的な内容が良く分かりませんので、申し訳ないのですが、答えようが有りません。
    例えば、フォルダパスとアクセスのファイル名は、どこから取得するのか? 処理対象のアクセスのファイルは複数あるとして、どの程度の数なのか。などなど。


    2019年5月29日 15:17
  • どういうデータをどのように格納するかは分かりませんし、Access も使えないので
    分かりませんが VBA なら FileSystemObject を使えばテキストファイルの中身は
    読み書きできます。

    ' 参照設定しているときは以下はいらない
    Private Const ForReading = 1
    
    Sub test()
        Dim fn As String
    
        ' ファイルのフルパス
        fn = "C:\hoge\hogehoge.txt"
    
        ' 参照設定しているときは以下のようにできる
        ' With New FileSystemObject
        With CreateObject("Scripting.FileSystemObject")
            ' テキストファイルを開く
            With .OpenTextFile(fn, ForReading)
                ' ファイルの内容を全て読み取って
                ' イミディエイト ウィンドウに表示する
                ' (イミディエイト ウィンドウでは
                ' SJIS 範囲外は文字化けするので注意)
                Debug.Print .ReadAll
                ' ファイルを閉じる
                .Close
            End With
        End With
    End Sub
    

    参照設定で Microsoft Scripting Runtime を有効にすれば CreateObject ではなく
    New FileSystemObject でオブジェクトを作成できます。

    2019年5月29日 15:23
  • 情報が足りず申し訳ありません。

    特定のフォルダパス配下にあるアクセスファイルのモジュールコードを
    テキストファイルの行に出力したいと考えています。
    下記サイト様の情報をもとに特定のフォルダパス配下のアクセスファイルをテーブルに出力させることが出来ました。
    https://selifelog.com/blog-entry-330.html

    モジュールコードはsaveastext関数でテキストファイルに出力することが出来ました。
    あとは同じレコードにsaveastextの出力結果を書き込みたいと考えたのですが、
    テキストファイルのインポート方法しか確認できずレコードがずれてしまうので
    一つのレコードに出力できるかわからず今回の質問に至りました。


    ◇追加質問
    infadeさんの回答でイミディエイトウィンドウに出力したいデータを表示させることはできたのですが、
    このデータをテキストファイルのフィールドに出力させる方法がわかりません…変数を直接指定してもダメなのでしょうか。

    サンプルコードが今手元にないのでうまく説明できているかわかりませんが、
    引き続きご教示をお願いできますでしょうか。


    2019年5月29日 21:27
  • optivueさん、こんにちは。

    既存レコードの上書きであれば、こちらを参照されればよいのではないでしょうか。ほかにも検索可能かと存じますが。

    https://www.feedsoft.net/access/guide-vba/guide20.html

    2019年5月30日 1:27
  • フォルダパス    ファイル名     テキストファイル

    C:\Temp            |    test.accdb      |         abcdefg                | ←テキストファイルのフィールドにはtest.txtの中身が出力される

    C:\Temp            |    test2.accdb     |         111222                | ←テキストファイルのフィールドにはtest2.txtの中身が出力される

    質問文では『ファイル名と同じテキストファイル』と書かれていますが…

    [ファイル名] フィールドにある名前は test.accdb / test2.accdb であるのに対し、
    読み取りたいテキストファイルは test.txt / test2.txt ということで
    ファイル名の拡張子が違っているように見受けられます。

    テキストファイル名を決定するために、[ファイル名] フィールドの拡張子を
    .accdb から .txt に変更する必要があるのでしょうか。

    Option Compare Database
    Option Explicit
    
    Public Sub Example_Start()
        If MsgBox("実験用テーブルを作成しますか?", vbQuestion Or vbYesNo) = vbYes Then
            CreateDemoData
        End If
        
        Dim fso As Object  ' As Scripting.FileSystemObject
        Set fso = CreateObject("Scripting.FileSystemObject")
        
       
        MsgBox "txt ファイルの内容をテーブル内に書き込みます", vbInformation
        Const adCmdTableDirect As Long = 512
        Const adLockOptimistic As Long = 3
        Dim conn As Object ' As ADODB.Connection
        Set conn = CurrentProject.Connection
        
        conn.BeginTrans
        
        Dim txtPath As String
        Dim rs As Object  ' As ADODB.Recordset
        Set rs = CreateObject("ADODB.Recordset")
        rs.LockType = adLockOptimistic
        rs.Open "テキストデータ", conn, Options:=adCmdTableDirect
        Do Until rs.EOF
            txtPath = fso.BuildPath(rs.Fields("フォルダパス").Value, _
                fso.GetBaseName(rs.Fields("ファイル名").Value) & ".txt")
            
            If fso.FileExists(txtPath) Then
                Debug.Print "ファイルを読み取ります。", txtPath
                rs.Update "テキストファイル", ReadAllText(txtPath, "Shift_JIS")
            Else
                Debug.Print "ファイルが見つかりません。", txtPath
                rs.Update "テキストファイル", Null
            End If
            
            rs.MoveNext
        Loop
        rs.Close
    
        conn.CommitTrans
        
        MsgBox "書き換えが完了しました", vbInformation
    End Sub
    
    
    Private Sub CreateDemoData()
        Dim conn As Object ' As ADODB.Connection
        Set conn = CurrentProject.Connection
        
        Dim sql As String
        
        sql = "CREATE TABLE [テキストデータ]" & vbCrLf _
            & "( ID COUNTER(10000, 10) PRIMARY KEY" & vbCrLf _
            & ", [フォルダパス] NVARCHAR(255) NOT NULL" & vbCrLf _
            & ", [ファイル名] NVARCHAR(255) NOT NULL" & vbCrLf _
            & ", [テキストファイル] LONGTEXT NULL" & vbCrLf _
            & ")"
        conn.Execute sql
    
    '    sql = "CREATE TABLE [バイナリデータ]" & vbCrLf _
    '        & "( ID COUNTER(10000, 10) CONSTRAINT ID PRIMARY KEY" & vbCrLf _
    '        & ", [フォルダパス] NVARCHAR(255) NOT NULL" & vbCrLf _
    '        & ", [ファイル名] NVARCHAR(255) NOT NULL" & vbCrLf _
    '        & ", [バイナリファイル] BINARY NULL" & vbCrLf _
    '        & ")"
    '    conn.Execute sql
    
        Application.RefreshDatabaseWindow
        conn.BeginTrans
    
        sql = "INSERT INTO [テキストデータ]" & vbCrLf _
            & "( [フォルダパス], [ファイル名], [テキストファイル] ) " & vbCrLf _
            & "VALUES ( FolderPath, FileName, Contents )"
        
        Dim cmd As Object  ' As ADODB.Command
        Set cmd = CreateObject("ADODB.Command")
        Set cmd.ActiveConnection = CurrentProject.Connection
        cmd.CommandText = sql
        cmd.Parameters.Refresh
        
        cmd!FolderPath.Value = "C:\Temp"
        cmd!fileName.Value = "test.accdb"
        cmd!Contents.Value = Null
        cmd.Execute
        
        cmd!FolderPath.Value = "C:\Temp"
        cmd!fileName.Value = "test2.accdb"
        cmd!Contents.Value = Null
        cmd.Execute
        
        cmd!FolderPath.Value = "C:\Program Files\dotnet"
        cmd!fileName.Value = "LICENSE.txt"
        cmd!Contents.Value = Null
        cmd.Execute
       
        conn.CommitTrans
    End Sub
    
    '第1引数:テキストファイルのフルパス
    '第2引数:テキストファイルの文字コード("Shift_JIS" とか "UTF-16" とか "UTF-8" とか)、省略時は自動判定
    Public Function ReadAllText(ByVal targetFilePath As String, Optional characterSet As Variant) As String
        Const adTypeText As Long = 2
        Const adReadAll As Long = -1
        Dim stm As Object  ' As ADODB.Stream
        Set stm = CreateObject("ADODB.Stream")
        stm.Type = adTypeText
        stm.Charset = IIf(IsMissing(characterSet), "_autodetect_all", characterSet)
        stm.Open
        stm.LoadFromFile targetFilePath
        ReadAllText = stm.ReadText(adReadAll)
        stm.Close
    End Function
    
    'Public Function ReadAllBytes(ByVal targetFilePath As String) As Byte()
    '    Const adTypeBinary As Long = 1
    '    Const adReadAll As Long = -1
    '    Dim stm As Object  ' As ADODB.Stream
    '    Set stm = CreateObject("ADODB.Stream")
    '    stm.Type = adTypeBinary
    '    stm.Open
    '    stm.LoadFromFile targetFilePath
    '    ReadAllBytes = stm.Read(adReadAll)
    '    stm.Close
    'End Function
    '


    • 編集済み 魔界の仮面弁士MVP 2019年5月31日 5:44 コードに説明コメント追加
    • 回答としてマーク optivue 2019年6月3日 10:42
    • 回答としてマークされていない optivue 2019年6月3日 10:43
    • 回答としてマーク optivue 2019年6月3日 10:43
    2019年5月31日 1:52
  • 回答が遅くなり申し訳ございません。サンプルコードありがとうございます。
    また説明が下手で申し訳ありませんでした。

    テキストファイル名は別のところから取得して、テーブルに書き込み、そのテーブルの名前を参照して
    テキストファイルフィールドに出力させる想定でした。
    いただいたサンプルコードを基に作り直して、取り込みたいテキストをテーブルに出力させることが出来ました。

    ご教示いただきありがとうございました。
    2019年6月3日 10:43