タグ: Access

Accessで住所支援入力というのがあるが、プロパティで設定せずにロジックで行うにはどうしたらよいかという問題への対応策。
使うのは住所支援入力で使っているライブラリと同じもの(だとは思う)。MsYubin7.dll。

３つのテキストボックスPrefText、CityText、TownTextに、都道府県、市区町村、町域をそれぞれ設定する前提で。

まず呼出元。

Dim res() As String
ConvZip2arrAddr("1600005",res)
PrefText = res(0)
CityText = res(1)
TownText = res(2)

まず呼出先。これは別モジュールを作成して記載しておけばいい。

Private Declare PtrSafe Function zcGetZipDecision Lib "MSYubin7.dll" Alias "GetZipDecision" _
                                                                            (ByVal ZipCode As String, _
                                                                            ByVal szKen As String, _
                                                                            ByVal szCty1 As String, _
                                                                            ByVal szCty2 As String, _
                                                                            ByVal szTwn As String, _
                                                                            ByVal szTwnExt As String) As Long

Public Sub ConvZip2arrAddr(ByRef zipCd As String, arrAddr() As String)
    
    Dim pref    As String * 40
    Dim city1   As String * 40
    Dim city2   As String * 40
    Dim town1   As String * 40
    Dim town2   As String * 500
    Dim arrRet(4)    As String
    
    On Error GoTo ErrFunc
    
    If zipCd = vbNullString Then Exit Sub
    If Len(zipCd) <> 7 Then Exit Sub

    If Val(zipCd) Then
        zcGetZipDecision zipCd, pref, city1, city2, town1, town2
        arrRet(0) = Left$(pref, InStr(pref, vbNullChar) - 1)
        arrRet(1) = Left$(city1, InStr(city1, vbNullChar) - 1)
        arrRet(2) = Left$(city2, InStr(city2, vbNullChar) - 1)
        arrRet(3) = Left$(town1, InStr(town1, vbNullChar) - 1)
        arrRet(4) = Left$(town2, InStr(town2, vbNullChar) - 1)
        ReDim arrAddr(0 To 2)
        arrAddr(0) = arrRet(0)
        arrAddr(1) = arrRet(1) & arrRet(2)
        arrAddr(2) = arrRet(3) & arrRet(4)
    End If
    Exit Sub
    
ErrFunc:
    Debug.Print "No." & Err.Number & ":" & Err.Description
End Sub

Access2019で試したが、他のバージョンでもそれほど違いはないと思う。

AccessではAutoExecなどという起動時に走らせるマクロがある。
ExcelならばAuto_Openなどというプロシージャで昔は作っていたようだ。（今だとThisWorkbook_Openとかだろうか）

Accessファイルを起動するとき、このマクロを起動させたくなければ、一旦Shiftキーを押しながらファイルを開くのだが、これをVBAで実施したいときどうすればよいのだろうか・・・

Excelファイルを開くときは、

Excel.Application.EnableEvents = False

とすればよいのだが、Access.Applicationにはそのようなプロパティがない。

というので、前にちらっとSendKeyでShiftキーを押して起動しているコードを見たこともあり、同じようなものを作ってみることにした。
ただ、SendKeyはちょっと嫌なのでSendInputというAPIを使った方法にすることにした。（どっちも嫌だけど）

まずはTypeの定義

Private Type KEYBDINPUT
    VK          As Integer
    Scan        As Integer
    Flags       As Long
    Time        As Long
    ExtraInfo   As Long
    Dummy1      As Long
    Dummy2      As Long
End Type

Private Type INPUT_TYPE
    IType           As Long
    KI              As KEYBDINPUT
End Type

WinAPIの定義(64bitの場合PtrSafeをお忘れなく)

Private Declare Function SendInput Lib "user32.dll" (ByVal nInputs As Long, pInputs As INPUT_TYPE, ByVal cbsize As Long) As Long

利用する定数の定義

Private Const VK_SHIFT        As Long = &H10          'Shiftキー
Private Const KEYEVENTF_KEYUP As Integer = &H2        'KeyUp(KeyDownのほうは0)
Private Const KEYEVENTF_EXTENDEDKEY As Integer = &H1  '拡張コード
Private Const INPUT_KEYBOARD As Integer = 1           'KeyboardイベントでSendInputを利用する

ここまでで定義が済んだので、Accessファイル起動処理を書いていく。
SendInputについての情報は以下の通り。

• SendInputはMouseイベントなどでも利用できるので、Keyboardイベントであることを指定する。
• Shiftキーを押した→ファイルを起動した・・・とここまでで終わりではなく、Shiftキーを戻す(KeyUp)の処理まで行わないと、ずっとShiftキーが押された状態のままになってしまう。
• SendInputの最初の引数はイベントの数で今回は1つなので1。例えば、Dキー⇒Oキー⇒Enterキーと押す場合は3。
• SendInputの第2引数は押下するキーの情報(配列)、第3引数は第2引数のデータ長。

    Dim ac As Object
    set ac = CreateObject("Access.Application")
    Dim it(0) As INPUT_TYPE

    'Shiftキー押下
    With it(0)
        .IType = INPUT_KEYBOARD        
        .KI.Vk = VK_SHIFT             
        .KI.Scan = 0
        .KI.Flags = KEYEVENTF_EXTENDEDKEY Or 0                'DOWN
        .KI.Time = 0
        .KI.ExtraInfo = 0
    End With
    SendInput 1, it(0), Len(it(0))
    
    'Accessファイルを開く
    ac.OpenCurrentDatabase {起動するファイル名}, True, {パスワード}
        
    'Shiftキー押下の戻し
    it(0).KI.Flags = KEYEVENTF_EXTENDEDKEY Or KEYEVENTF_KEYUP   'UP
    SendInput 1, it(0), Len(it(0))

最終的にAccessを閉じて処理終了

    ac.Quit acQuitSaveNone

フラグを渡すのに「KEYEVENTF_EXTENDEDKEY Or 」というのをつけないと、反映されなかった。
ここに手間取り結構時間がかかったのと、あとはとにかく「こんなことやりたいねん！」って検索しても出てこない、っていうところで時間がかかった。
VBA Access Autoexec 無効 とかキーにしても、Shiftキー押しながら起動すればいいよ！としか出なくて腹立つぅ～～～!!
って思ってしまった。検索能力ってIT技術の１つだなぁ～とつくづく実感。

参考URL
VBレスキュー(花ちゃん) 『３．SendInput 関数を使ってプログラム上からキーボードを操作する(12_Key_03)』

Microsoft Windowアプリ開発『仮想キー コード』

ファイル渡すからプログラム組んでくれ、っていわれてプログラム作成している最中、
ファイルも寄越さないうちから、「進捗どうですか？」って聞かれて、ちょいムカっとしたのは今週の始め。
んで、ムカついたからもう少し待ってねメールのついでに、送ってきた中途半端な仕様書の「重箱の隅にもならない場所」(ちゃんと書いて！ってな場所）をつつくような質問を畳みかけてやった。（フン！）

まぁ、別に大して怒っている訳ではないのだが、
　「自分がやるべきこともしないで、なんなんだ？」とか、
　「いやいや○日かかるって言ってるでしょ！何日目だよ今日！」とか・・・
色々思うところはあった。
そうは言いつつ、自分もこうならないように気を付けようと、ちょいと思ったのだった。

で、慣れないDoCmdに苦戦しつつ、ExcelファイルをReadOnlyで開いて、データを読込み、終わったら閉じる処理を書いてみた。
DisplayAlertsをFalseにしているのは、Excelで発生したエラーやら確認メッセージを出させないためだけで、値をとってくるだけなら特に必要はないと思う。

Dim xls As Object
Dim wb  As Object

Set xls = CreateObject("Excel.Application")
xls.DisplayAlerts = False
Set wb = xls.Workbooks.Open(FileName:=[Excelパス], ReadOnly:=True)

 ・・・（読込処理）・・・

wb.Close SaveChanges:=False
Set wb = Nothing 
xls.DisplayAlerts = True
xls.Quit
Set xls = Nothing

面倒だなぁ・・・Excelでいいじゃん？
だって、xlUpとかxlToLeftとかのExcelVBA特有の定数も使えないし。
（参照設定で設定すれば、使えるようにはなるけどサ）

とは思ったのだが、まぁ、後々Accessの方がいいこともあるかもって思ったので、お客さんの言うとおりAccessにした。
だけど、やはり、今回は、Accessにデータを取込むわけでもなく、別DBに出力するロジックだったので、尚更、AccessでExcelを開くというのは、かなり馬鹿馬鹿しく感じた。
もちろん、できるならImportしたいところだが、できるほど単純なデータではなかったので、わざわざロジックを組む。

　　・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・

で、今回は読み込んだデータをAccessテーブルには放り込まなかったのだが、Accessに取込むとなるとどうするのか・・・ということも考えてみた。

しっかし、AccessのTableってのは、INSERT文で出力しようが、AddNew・Updateで入れてみようが、まぁ、遅いのなんの・・・
さらに複数のSQL文を一括実行する方法なんて探してみたのだが、

Accessにはない！

ということなので、１つ思いついたのが、
　・Excelデータを取込んで、テーブルImport用のCSVを作成。
　・CSVをImportする。
という方法。
確かに、INSERTを発行するより速いのだが、かといって、すこぶる速いという訳でもなかった。件数が多ければ、明らかに速くなる気はする。

しかし、ここで問題発生。文字コードだ。

UTF-8文字が入力されたExcelデータであったため、ADO.Streamを利用して、BOM無しのUTF8でCSV出力。
かつ、インポートするときも

　DoCmd.TransferText acImportDelim, , temp_table , csv_path, True, , 65001 　　

というように、文字コード(65001がUTF-8を示す)を指定して取込む必要があった。

ということで、いろいろ試しにやったのだが、プログラム自体はすんなり作成できた。

ってか、まだファイル来ないし・・・