パソコン(ソフト)

【Access】テーブルエクスポート時のフィールド名(先頭行)を変更

マイクロソフトデータベースアクセス(以下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のフィールド名を変更するにはリスクが高いと判断したので、下記の様な処理フローを考えました。

まず、リンクテーブルと同じ構造のローカルテーブルを作成しました。

参考

  1. ローカルテーブル内のデータを消去(リセット)
  2. 抽出データをローカルテーブルに追加
  3. エクスポート前に、フィールド名を変更
  4. エクスポート
  5. フィールド名を元に戻す

 

つまり、リンクテーブルをエクスポートするのではなく、一旦作業テーブルにエクスポートしたいデータを追加してからエクスポートしているのです。

 

実際の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に処理したいSQLコードを書き込み、DoCmd.RunSQLで実行させてローカルテーブルにデータ追加しています。

エクスポートする前後で、下記の様なVBAコードでフィールド名を書き換えています。

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

 

 

-パソコン(ソフト)
-, , , , , , , ,

Translate »

© 2021 PCTips