マイクロソフトデータベースアクセス（以下Access）において、データをCSVファイルなどにエクスポートするケースがある。
そんな時に、テーブルやクエリをそのままエクスポートする方法が簡単ですが、
ココがポイント
フィールド名（先頭行）を変えたい
ケースがあります。
テーブルのフィールド名を変えるVBA
Public Sub FieldNameChange()
Dim dbs As Database
Set dbs = CurrentDb
'ここでテーブル名を指定します
With dbs.TableDefs("tblデータ1")
'現在のフィールド名（左辺）と新しい名前（右辺）を列挙します。
.Fields("フィールド1").Name = "ID"
.Fields("フィールド2").Name = "社員番号"
.Fields("フィールド3").Name = "名前"
.Fields("フィールド4").Name = "ふりがな"
.Fields("フィールド5").Name = "生年月日"
.Fields.Refresh
End With
End Sub
ネットを検索していましたら、AccessTips様のホームページにVBAコードがありましたので参考にさせていただきました。
フィールド名を変更する必要性！？
データベース部分は、Sqlserverと接続をしているので、フィールド名に日本語を使わない方が良いかと考えてすべて英文のフィールド名にしていました。
もちろんAccessにリンクテーブルしたテーブルをエクスポートすると先頭行がフィールド名となりエクスポートされました。
自分は、なんとなくわかるので全く問題なかったのですが、
ココに注意
使う人が日本語にしてくれないと分かりずらいという要望
が出たのです。
ただ、Sqlserverのフィールド名を変更するにはリスクが高いと判断したので、下記の様な処理フローを考えました。
まず、リンクテーブルと同じ構造のローカルテーブルを作成しました。
参考
- ローカルテーブル内のデータを消去（リセット）
- 抽出データをローカルテーブルに追加
- エクスポート前に、フィールド名を変更
- エクスポート
- フィールド名を元に戻す
つまり、リンクテーブルをエクスポートするのではなく、一旦作業テーブルにエクスポートしたいデータを追加してからエクスポートしているのです。
実際のVBAコード
Private Sub csv_xport_Click()
Dim cn As ADODB.Connection
Dim rs As ADODB.Recordset
Dim hantei As Integer
Dim naiyou As String
Dim flg As Boolean
Dim strSql As String
Dim strPath As String
Dim FolderName As String
'アクションクエリ非表示設定
DoCmd.SetWarnings False
FolderName = getFolderName("") '引数に初期値のフォルダーパスを設定、""にするとドキュメントフォルダー
If FolderName = "" Then
MsgBox "キャンセルされました。"
Else
' 条件が設定されてない時は抽出しない
If Nz(Me.search_mado, "") = "" And Nz(Me.delivery_mado, "") = "" And Nz(Me.trader_search, "") = "" And Nz(Me.pu_date_start, "") = "" And Nz(Me.pu_date_end, "") = "" And Nz(Me.delivery_date_start, "") = "" And Nz(Me.delivery_date_end, "") = "" Then
Call 解除ボタン_Click
Exit Sub
End If
haitei = 0
If Nz(Me.pu_date_start, "") <> "" And Nz(Me.pu_date_end, "") <> "" Then
hantei = hantei + 1
ElseIf Nz(Me.pu_date_start, "") <> "" Then
If Nz(Me.pu_date_end, "") = "" Then
MsgBox "集荷日終了が入力されていません"
Exit Sub
End If
ElseIf Nz(Me.pu_date_end, "") <> "" Then
If Nz(Me.pu_date_start, "") = "" Then
MsgBox "集荷日開始が入力されていません"
Exit Sub
End If
End If
If Nz(Me.delivery_date_start, "") <> "" And Nz(Me.delivery_date_end, "") <> "" Then
hantei = hantei + 10
ElseIf Nz(Me.delivery_date_start, "") <> "" Then
If Nz(Me.delivery_date_end, "") = "" Then
MsgBox "配達日終了が入力されていません"
Exit Sub
End If
ElseIf Nz(Me.delivery_date_end, "") <> "" Then
If Nz(Me.delivery_date_start, "") = "" Then
MsgBox "配達日開始が入力されていません"
Exit Sub
End If
End If
If Nz(Me.search_mado, "") <> "" Then ' 出荷人
hantei = hantei + 100
End If
If Nz(Me.trader_search, "") <> "" Then ' 業者
hantei = hantei + 1000
End If
If Nz(Me.delivery_mado, "") <> "" Then ' 配達先
hantei = hantei + 10000
End If
naiyou = "(trader1 ='" & Me!trader_search & "'or trader2 = '" & Me!trader_search & "'or trader3 = '" & Me!trader_search & "'or trader4 = '" & Me!trader_search & "'or trader5 = '" & Me!trader_search & "')"
On Error GoTo Err_Handler
' Set cn = CurrentProject.AccessConnection
' Set rs = New ADODB.Recordset
' With rs
' Set .ActiveConnection = cn
If hantei = 100 Then ' 出荷人
strSql = "INSERT INTO export_job_table SELECT * FROM orderdata_sorting WHERE shipper ='" & Me!search_mado & "'"
ElseIf hantei = 101 Then ' 出荷人+集荷日
strSql = "INSERT INTO export_job_table SELECT * FROM orderdata_sorting WHERE shipper ='" & Me!search_mado & "' And pu_date Between #" & Me!pu_date_start & "# AND #" & Me!pu_date_end & "#"
ElseIf hantei = 111 Then ' 出荷人+集荷日+配達日
strSql = "INSERT INTO export_job_table SELECT * FROM orderdata_sorting WHERE shipper ='" & Me!search_mado & "' And pu_date Between #" & Me!pu_date_start & "# AND #" & Me!pu_date_end & "#" & "And delivery_date Between #" & Me!delivery_date_start & "# AND #" & Me!delivery_date_end & "#"
ElseIf hantei = 10101 Then ' 出荷人+配達先+集荷日
strSql = "INSERT INTO export_job_table SELECT * FROM orderdata_sorting WHERE shipper ='" & Me!search_mado & "'And delivery_name = '" & Me!delivery_mado & "' And pu_date Between #" & Me!pu_date_start & "# AND #" & Me!pu_date_end & "#"
ElseIf hantei = 11 Then ' 集荷日+配達日
strSql = "INSERT INTO export_job_table SELECT * FROM orderdata_sorting WHERE pu_date Between #" & Me!pu_date_start & "# AND #" & Me!pu_date_end & "#" & "And delivery_date Between #" & Me!delivery_date_start & "# AND #" & Me!delivery_date_end & "#"
ElseIf hantei = 1000 Then ' 業者
strSql = "INSERT INTO export_job_table SELECT * FROM orderdata_sorting WHERE " & naiyou
ElseIf hantei = 11000 Then ' 業者+配達先
strSql = "INSERT INTO export_job_table SELECT * FROM orderdata_sorting WHERE delivery_name = '" & Me!delivery_mado & "' and " & naiyou
ElseIf hantei = 11001 Then ' 業者+配達先+集荷日
strSql = "INSERT INTO export_job_table SELECT * FROM orderdata_sorting WHERE delivery_name = '" & Me!delivery_mado & "' and pu_date Between #" & Me!pu_date_start & "# AND #" & Me!pu_date_end & "#" & " and " & naiyou
ElseIf hantei = 1001 Then ' 業者+集荷日
strSql = "INSERT INTO export_job_table SELECT * FROM orderdata_sorting WHERE pu_date Between #" & Me!pu_date_start & "# AND #" & Me!pu_date_end & "#" & " and " & naiyou
ElseIf hantei = 1101 Then ' 出荷人+業者+集荷日
strSql = "INSERT INTO export_job_table SELECT * FROM orderdata_sorting WHERE shipper ='" & Me!search_mado & "' And pu_date Between #" & Me!pu_date_start & "# AND #" & Me!pu_date_end & "#" & " and " & naiyou
ElseIf hantei = 1 Then ' 集荷日
strSql = "INSERT INTO export_job_table SELECT * FROM orderdata_sorting WHERE pu_date Between #" & Me!pu_date_start & "# AND #" & Me!pu_date_end & "#"
ElseIf hantei = 10 Then ' 配達日
strSql = "INSERT INTO export_job_table SELECT * FROM orderdata_sorting WHERE delivery_date Between #" & Me!delivery_date_start & "# AND #" & Me!delivery_date_end & "#"
' Debug.Print .Source
Else
MsgBox "設定外の抽出項目です。設定し直して再抽出してください。"
Exit Sub
End If
'エクスポート処理
DoCmd.RunSQL "DELETE * from export_job_table"
DoCmd.RunSQL strSql
Call FieldNameChange 'フィールド名日本語化
DoCmd.TransferText acExportDelim, , "export_job_table", FolderName & "\抽出CSV_" & Format(Now(), "yyyymmddhhnn") & ".csv", True
Call FieldNameChange_undo 'フィールド名元に戻す処理
MsgBox "エクスポート完了しました。"
End If
ExitErr_Handler:
Exit Sub
Err_Handler:
MsgBox "エラー： " & Err.description
End Sub
グダグダと長いコードですが、エクスポートボタンを押すと、
Windowsのフォルダを指定するダイヤログが表示されて、エクスポートするフォルダーを指定することができます。
strSqlに処理したいＳＱＬコードを書き込み、DoCmd.RunSQLで実行させてローカルテーブルにデータ追加しています。
エクスポートする前後で、下記の様なＶＢＡコードでフィールド名を書き換えています。
Call FieldNameChange 'フィールド名日本語化
DoCmd.TransferText acExportDelim, , "export_job_table", FolderName & "\抽出CSV_" & Format(Now(), "yyyymmddhhnn") & ".csv", True
Call FieldNameChange_undo 'フィールド名元に戻す処理
Public Sub FieldNameChange()
Dim dbs As Database
Set dbs = CurrentDb
'ここでテーブル名を指定します
With dbs.TableDefs("export_job_table")
'現在のフィールド名（左辺）と新しい名前（右辺）を列挙します。
.Fields("confirmed").Name = "依頼確定"
.Fields("reception_date").Name = "受付日"
.Fields("reception_time").Name = "受付時間"
'％％％％ 略 ％％％％
.Fields("flag").Name = "オーダー状態"
.Fields("mgflag").Name = "メッセージフラグ"
.Fields.Refresh
End With
End Sub
Public Sub FieldNameChange_undo()
Dim dbs As Database
Set dbs = CurrentDb
'ここでテーブル名を指定します
With dbs.TableDefs("export_job_table")
'現在のフィールド名（左辺）と新しい名前（右辺）を列挙します。
.Fields("依頼確定").Name = "confirmed"
.Fields("受付日").Name = "reception_date"
.Fields("受付時間").Name = "reception_time"
'％％％％ 略 ％％％％
.Fields("オーダー状態").Name = "flag"
.Fields("メッセージフラグ").Name = "mgflag"
.Fields.Refresh
End With
End Sub