パソコン情報

【Access】フィールド１個とフォーム上のコンボボックス２個のフィールドを結合させたCSVファイルを出力

完全版を表示する

やりたい内容

やりたい事は、テーブル（WEBDATA）のフィールド（user_id）１個と

フォーム上にあるコンボボックス２個（年：ComboBox1、月：ComboBox2）を結合させて、WEBDATAテーブルのfile_nameフィールドに書き込みたい。

フィールド３個が結合された内容に、拡張子の「.pdf」を付けてfile_nameフィールドが更新された内容が下記になります。

まず、ここまでが、第一段階になるかと思います。

そして、最終的には、

ココがポイント

WEBDATAの内容を、csvファイルとしてタブ区切りで出力したい

というのが目的になります。

 

１つのフィールドと、２個のテキストボックスを結合

まず第一段階として、テーブルの１つのフィールド（user_id）とフォーム上にあるコンボボックス（ComboBox1とComboBox2）を結合させ、更に、「.pdf」の拡張子も結合させます。

下記がVBA内容になります。

Private Sub text_output_csv_Click()

Dim cn As ADODB.Connection
Dim rs As ADODB.Recordset

On Error GoTo ErrRtn

If IsNull(ComboBox1) Then
    MsgBox ("年の選択がされていません。")
    Exit Sub
End If

If IsNull(ComboBox2) Then
    MsgBox ("月の選択がされていません。")
    Exit Sub
End If

'変数にADOオブジェクトを代入
Set cn = CurrentProject.Connection
Set rs = New ADODB.Recordset
rs.CursorLocation = adUseClient
    
'レコードセットを取得
rs.Open "WEBDATA", cn, adOpenKeyset, adLockOptimistic
          
    Do Until rs.EOF
                rs!file_name = rs!user_id & ComboBox1 & ComboBox2 & ".pdf"
                rs.Update
                rs.MoveNext    
    Loop
    
'終了処理
rs.Close: Set rs = Nothing
cn.Close: Set cn = Nothing

ExitErrRtn:
    MsgBox "指定されたフォルダにエクスポートしました。"
    Exit Sub
 
ErrRtn:
    MsgBox "エラー： " & Err.Description
    '終了処理
    rs.Close: Set rs = Nothing
    cn.Close: Set cn = Nothing

End Sub

フィールド上のボタンに上記のＶＢＡを設定して実行させたところ、下記のようにテーブルのfile_nameが更新されていました。

 

csvファイルをダイアログを開いた指定フォルダに出力

次に、WEBDATAテーブルの内容を、タブ区切りのcsvファイルをダイアログで指定したフォルダに出力させます。

過去にダイアログを使ったｃｓｖファイルの出力方法があるので下記を参考にしてください。

参考
【Access】日付付きCSVファイルを都度指定したフォルダに出力する方法

  過去の記事に、Access（マイクロソフトアクセス＝データベース）で、テーブルをCSVとエクセルにエクスポートする方法を書いたことがあります。その時には、ファイルの保存先とファイル名を都 ...

続きを見る

 

まずは、標準モジュールを設定しました。

このモジュールは何も考えずに、コピペするだけです。

Option Compare Database

'--------------------------------------------------------------------
'フォルダ選択ダイアログ
'---------------------------------------------------------------------

Public Function getFolderName(tmpFilePath As String) As String

    Dim intret As Integer

    With Application.FileDialog(msoFileDialogFolderPicker)

        'ダイアログのタイトルを設定
        .Title = "フォルダ選択ダイアログ"

        'デフォルトのフォルダパス
        .InitialFileName = tmpFilePath

        'ダイアログを表示
        intret = .Show
        If intret <> 0 Then
          'フォルダが選択されたとき戻り値に設定
          getFolderName = Trim(.SelectedItems.Item(1))
        Else
          'フォルダが選択されなければ長さゼロの文字列を返す
          getFolderName = ""
        End If
    End With

End Functionつ

次に、先ほどの結合処理の終わりに、Callでサブルーチンを設定しました。

CSVファイルが出力できるようになったのはいいのですが・・・

このcsvファイルから、先頭レコードのフィールド名を削除して、IDフィールドを削除して、タブ区切りにできれば完成になります。

 

必要項目だけに絞りタブ区切り出力

必要項目だけに絞ってタブ区切りで出力するには、まず、必要項目（フィールド）だけのテーブルかクエリが必要みたいです。

ということで、自分の場合は、「WEBDATA_CSV」という選択クエリを作成しました。

ここから、エクスポート定義を作成するのですが、手動で出力させる手順の途中に、エクスポート定義を保存する場所がありました。

ここで、「タブ区切り」「文字列の引用符」などを設定することができました。

あとは、DoCmd.TransferTextの場所に手を加えるだけで欲しいCSVデータの出力をすることができました。

Sub csv_output()

 Dim FolderName As String
 
    FolderName = getFolderName("")   '引数に初期値のフォルダーパスを設定、""にするとドキュメントフォルダー
    If FolderName = "" Then
        MsgBox "キャンセルされました。"
    Else
       
        DoCmd.TransferText _
        TransferType:=acExportDelim, _
        specificationname:="WEBDATA_CSV エクスポート定義", _
        TableName:="WEBDATA_CSV", _
        FileName:=FolderName & "\test_" & Format(Date, "yyyymmdd") & ".txt"
        
    End If
End Sub

ちなみに、出力ファイルに本日の日付も付加してみました。

以上で必要なCSVファイルの出力ができました。