饂飩コーディング

iOSアプリやら、Unityやら、Cocos2dやらごにょごにょ書いております

AccessでWizHook使ってみよう。

サイトが引っ越しました。→https://scombu.com

約1秒後に自動的にリダイレクトします。切り替わらない場合はリンクをクリックしてください。

AccessでExelファイルのエクスポートやインポートするときには

DoCmd.TransferSpreadsheet acExport, acSpreadsheetTypeExcel9, "T-顧客", "ディレクトリ"
やら、
DoCmd.TransferSpreadsheet acImport, Excelのバージョン指定, インポート先テーブル名, Excelファイルパス, 先頭行を列名にする時はtrue, 取り込みシート名

VBAでやっちゃいますが、ダイアログボックスほしいですよね。
Microsoft推奨は以下のやり方かな。
appdeappuappu.hateblo.jp


インポートはAccess Object Liblaryでダイアログボックスを作り、
エクスポートはExce Object Liblaryを使ってダイアログを作ります。
f:id:appdeappuappu:20201106204721p:plain
それぞれ別の参照設定を設定すれば実装できるのですが、
Excel Object Liblaryを使った場合、Accessの画面の裏にダイアログが表示されることがあって
実務では「あれ?Access固まった??」的な事に陥ります。

そこで使えるのがWizHookです!!!

不要な参照設定を入れなくても使えるし、画面裏にまわることもないので使いやすいです。
マイクロソフトでは非推奨扱いなのは少々難ありですが使ってみましょう。非推奨なだけあって
公式情報での説明等は一切ない代わりに、ネット上にはいろいろ情報がころがっています。
検索してみると引数が時折変更になってるとかなってないとか・・・

オブジェクトブラウザで非表示項目を表示するとこんな感じで隠してあります。
引数もここで確認できるといえばできますね。
f:id:appdeappuappu:20201106220140p:plain


参考になるのがこちらのSE Life Log - VBAを中心にその他IT備忘録さんの記事。
https://selifelog.com/blog-entry-53.html

さて、実装してみます。


まずは、標準モジュールにWizHookをFunctionとして記述し保存します。

Function GetFileName(OpenOrSaveFlg As Boolean, strFilter As String, strTitle As String, defaultFileName As String) As Variant
    
    Dim returnValue As Integer
    Dim strFilePath As String
    
    If strFilter = "" Then
        strFilter = "全てのファイル (*.*)|*.*"
    End If
   
    WizHook.Key = 51488399 'WIZHOOK有効
    
    returnValue = WizHook.GetFileName( _
                    0, "", strTitle, "", defaultFileName, "", _
                    strFilter, _
                    0, 0, 0, OpenOrSaveFlg _
                    )
    WizHook.Key = 0 ' WizHook 無効
    'returnValueとstrFilePathの2つの値を返す
    'returnvalueの値を返すことで[キャンセル]が押されたかを判断するため
    GetFileName = Array(returnValue, strFilePath)
   
End Function


ボタンを押して呼び出す側はこんな感じで!

    Private Sub コマンド_エクスポート_Click()
    
    Dim sFina As String
    
    Dim ReturnArray As Variant
    ReturnArray = GetFileName(False, "ログファイル (*.xlsx)|*.xlsx|", "ダイアログタイトル", "sample.xlsx")
    
    If ReturnArray(0) = -302 Then
        'キャンセルボタンが押されたときの処理を記述
        MsgBox "キャンセルが押されました。"
    Else
        'ファイルが指定されたとこの処理を記述
        MsgBox ReturnArray(1)
        sFina = ReturnArray(1)
    End If
    
    If sFina <> "" Then
        DoCmd.TransferSpreadsheet acExport, acSpreadsheetTypeExcel12, "売上テーブル", sFina, True, "シートxxx"
        
    End If
    
    
End Sub


以下のようなダイアログが表示されて使いやすくなります。
f:id:appdeappuappu:20201106234915p:plain


なお、エクスポート時は保存用のダイアログとして
インポート時は読み取り(ファイルを開く)ダイアログとして使用できます。
使い分けは
ReturnArray = GetFileName(False, "ログファイル (*.xlsx)|*.xlsx|", "ダイアログタイトル", "sample.xlsx")
第一引数 False = 保存用のダイアログ
     True = 読み取り用のダイアログ
となります。