「ファイルのインポート・エクスポートをフォーム上で実行する」の
その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



ファイルの存在チェックのモジュール(存在していたら上書きするか確認。OKなら削除しておく)

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
【宣伝です】

↓当会で、DXビジネス発想塾をZoomにて実施します。
よろしければ詳細をご参照ください。ご参加をお待ちしております。
【JSDG】DX人財スタートアップシリーズ 第1講「DXビジネス発想塾」開催案内

【JSDG】DX人財スタートアップシリーズ 第1講「DXビジネス発想塾」開催案内