Accessのノウハウ（フォーム上でのエクスポート設定）

「ファイルのインポート・エクスポートをフォーム上で実行する」の
その2　エクスポート　版です。

インポートの項で、フォームの作り方・フォーマットテーブルとの連携の仕方・クエリの名前付け等について
お話しましたので、

エクスポートについては、まずは、モジュールサンプルを提示します。

フォームとモジュールサンプル

こんなフォームを作るとします。
レコードソースは、インポートと同じ　T_Formatです。

＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊

エクスポートボタンをクリックした時のサンプル　モジュールです。

Functionプロシージャ　CheckFile

ふぁ

1．エクスポートの構文

①Excelの時

DoCmd.TransferSpreadsheet acExport, acSpreadsheetTypeExcel12Xml, “Q_302_指定日付分を抽出”, myDir & myFN, True
↑これは、拡張子が　xlsx　の時
xls 　の時は、acSpreadsheetTypeExcel8
（注意1）

②CSVの時

DoCmd.TransferText acExportDelim, , “Q_302_指定日付分を抽出”, myDir & myFN,  True
（この場合は、カンマ区切り、ヘッダーあり）

③出力フォルダと出力ファイル名

ちなみに、myDir & myFN 　 は　こんな風に組み合わせます。
miDir　D:\OneDrive\ドキュメント\Accessブログ\
myFN  Sample.xlsx , Sample.xls , Sample.csv
以下のように年月（日）を組み合わせるケースも多いです。
myFN = Format(Date,”yyyymmdd”) & “_提出データトレース結果.xls”
↓
20200401_提出データトレース結果.xls　のように出力されます。

（注意1）Excelの型が合ってないとき、
例えば、本来xlsxなのに　拡張子を　xls としたときは、エラーとなります。
「破損している」とか「拡張子」があっていないなどのメッセージが出ます。

④Excelファイルのシート名

シート名を指定したいときは、
DoCmd.TransferSpreadsheet acExport, acSpreadsheetTypeExcel8, “Q_12クエリ名”, myDir & myFN, True,”シート名”
と入力しますが、そのままで問題無いときは、シート名は指定しないことが多いです。
その場合、シート名がクエリ名になります。
その方が、問題が起きたときトレースしやすい（＝クエリ名がわかるので、そこから追いかけやすい）

2．エクスポートの前の　色々なチェック

①フォルダの存在チェック

存在チェックだけでなく、「子フォルダが無い時は作る」という選択肢も作っておくと便利です。
MKDirで子フォルダが作れます。ただし、親フォルダが無いとエラーになります。

（いちばん簡単な書き方は以下だが、親フォルダが無いとエラーになる）
If Dir(myDir,vbDirectory)=”” Then
MkDir myDir
End If

親フォルダ全て作るには、
・一つずつフォルダの存在を見るモジュールを作るか
・HCreateDirectoryExというAPIを使うか
という方法はありますが、
私の経験上、Accessの定例出力では一つ下の階層を作りたいケースが殆どなので
MKDirで、ほぼ用は足りると思っています。
（例）\Accessブログ\振込状況トレース\20200401\Hurikomi_check.xlsx とか
※ちなみに最近勉強中のPythonだと　os.mkdir()　os.makedirs()の2種類でこなせて便利な様子

②ファイルの存在チェック

ファイル名の存在チェックと、上書きするかの選択肢の処理が必要です。
これが無いと既に同名のファイルがあると、エラーになります。

このチェックは、あちこちで使うので、別途Functionプロシージャを作って読み込んでいます。

Dir　で　存在をチェックして、
もしファイルがあれば、上書きするか聞いて、
上書きOKなら
Kill　で　削除します

③出力ファイル名

出力ファイル名は以下のパターンが多いと思います。

A．常に固定のファイル名　　Hurikomi_Check.xlsx 別のシステムに受け渡しをするケース
B．ファイル名の前に年月（日）をつける　20200401Hurikomi_check.xlsx
C．ファイル名の後に年月（日）をつける　Hurikomi_check20200401.xlsx

Aの場合は、フォルダ名に年月（日）をつけるケースが多いです。
2①の例で上げた様なパターンですね。（20200401\Hurikomi_check.xlsx ）
Bは、一度に複数のファイルをエクスポートする時に向いています。
時系列でエクスポートできるので、不要になった時に、まとめて削除しやすいです。
BとCのタイプが混在していると、結構不便なのでご注意ください。

例　以下のようになってしまい、
20200401未納者連絡.xlsx
20200402未納者連絡.xlsx
振込チェック20200401.xlsx
振込チェック20200402.xlsx

振込チェック20200401.xlsx
20200401未納者連絡.xlsx
を「ひとかたまり」に出来なくなってしまいます。

3．出力の際のフォームとクエリの組み合わせ

出力するときは、フォーム上で日付を指定して、その日付でクエリを絞り込み、出力するファイル名に日付もつけておく、なんていうパターンが多いです。

サンプルを表示しておきます。

ちなみに、エクスポート項目には、以下を含めた方がいいです。
①フォームで指定した条件（この場合、日付）

正しく抽出しているかどうか、「ファイルの中で確かめられるように」しておくことは結構大事です。
これがないと、間違って抽出しても気づかず、処理を進めてしまうことが結構あります。
そして最終段階で、数字がおかしいと気づく事が…（悲）

②名称だけでなく、その名称の元となるコード

例えば、部署名だけでなく、部署コードも含めないと、後でもう一度並び替えようと思ったときに
困ることがあります。

エクスポートのフォームの設定

フォームとクエリの連携

エクスポート結果

4．実際のモジュールのコード

いちおうコード貼っておきますね。テキストベースになってしまうので見にくいですが、
コピぺして、インデント等を整えれば、みやすくなるはず。

エクスポートボタンのモジュール

Private Sub cmd_Export2_Click()
    Dim myDir As String
    Dim myFN As String
    Dim myBtn_Make_Path As Boolean
    
    'フォーム上に書き込みがあるかチェック
    If IsNull(Me.txt_Export) Then
        MsgBox "フォルダパスを入力してください"
         Me.txt_Export.SetFocus

        Exit Sub
    End If
    
    '出力フォルダが見つからなかったら、フォルダを作る指定のラジオボタン
    'デフォルトは　True
    myBtn_Make_Path = Me.Botton_Make_Path
    
    'フォーム上に書き込まれた出力フォルダ名
    myDir = Me.txt_Export

    
    '出力フォルダ名の最後に\が無ければ\をつける
    If Right(myDir, 1) <> "\" Then
        myDir = myDir & "\"
    End If
    
    '出力フォルダがなければ作る
    '出力フォルダが見つからなかったら、フォルダを作る
    'そういう　ラジオボタンを作っておく
    'Botton_Make_Path =デフォルトは　True
    
    '出力フォルダの存在チェック
    If Dir(myDir, vbDirectory) = "" Then
        If myBtn_Make_Path = True Then
        '出力フォルダが無くて、
        'かつ「フォルダ無ければ作るボタン」があれば子フォルダを作る
        'ただしMkDirは親フォルダが無いとエラーになる
            On Error GoTo myError
            MkDir myDir
            On Error GoTo 0
        Else
            MsgBox "出力フォルダが見つかりません"
            Me.txt_Export.SetFocus
            Exit Sub
        End If
           
    End If
    
    '親フォルダ全て作るには、
    '一つずつフォルダの存在を見て作るか
    'SHCreateDirectoryExというAPIを使うか
    'という方法はあるけれど　Accessの出力ではもう一つ下の階層を作りたいケースが殆どなので
    'MKDirで、ほぼ用は足りる

   'ファイル名に年月をつける
   '何度も出力する場合は､年月日を前にしておいた方が､まとまった並び順になる
    myFN = Format(Date, "yyyymmdd") & "_振込状況トレース結果.xlsx"
    '例えば､画面に表示されている日付をセットするときは､
    myFN = Format(textDate, "yyyymmdd") & "_振込状況トレース結果.xlsx"
        
    'ファイルの存在チェック用のFunctionプロシージャ（関数）で処理
    '　　　　　　　　　　　　　CheckFile（パス名＋ファイル名)
    'ファイルの存在をチェックして、存在していたら上書きするかMSG
    '上書きYesなら、上書き　　そうでなければ終了
    If CheckFile(myDir & myFN) = False Then
        Exit Sub
    End If
   
    DoCmd.TransferSpreadsheet acExport, acSpreadsheetTypeExcel12Xml, "Q_302_指定日付分を抽出", myDir & myFN, True
   'ちなみに　  acSpreadsheetTypeExcel8　なら出力ファイル名は　「.xls」
   'これがずれていると、Excelを開くとき「ファイルが壊れている」の表示が出る

    MsgBox "終わり"

Exit Sub

myError:
           MsgBox "親フォルダが無いため、出力フォルダの作成が作成できませんでした"
           Me.txt_Export.SetFocus
Exit Sub
      
End Sub

Function CheckFile(myFilePath As String) As Boolean
  '同名のファイルがあるかチェック。あれば削除
    If Dir(myFilePath) = "" Then
        CheckFile = True
    Else
        myBtn = MsgBox("同名のファイルがあります。再作成してよろしいですか？" _
                      & vbCrLf & vbCrLf & _
                      "ファイル名：" & Dir(myFilePath), _
                      vbYesNoCancel + vbExclamation, "要確認")
           
           If myBtn = vbYes Then
                On Error GoTo Kill_Error
                Kill myFilePath
                On Error GoTo 0

                CheckFile = True
            Else
                MsgBox "中止"
                CheckFile = False
            End If
            
    End If
    
    Exit Function

Kill_Error:

    MsgBox Err.Number & vbCrLf & Err.Description
    
    CheckFile = fale
        
End Function

日付変換前処理のモジュール（「2020.4.1」を「2020/4/1」のカタチに変換する）

Function hiduke(keyDate As String) As Date
Dim myArray() As String

   '日付が「．」で区切られているので、配列型にする
   myArray = Split(keyDate, ".")
   '年、月、日に分ける
   hiduke = DateSerial(myArray(0), myArray(1), myArray(2))

End Function