2014年12月26日金曜日

ACCESSからVB.netへ 文字を送信

ACCESSから起動できないプログラムでVBからは起動できる
そんな場合にACCESSからパラメータとして文字送信をし
VBで受け取りその内容に応じて処理を行う
windows32 APIを利用 SendMessage

送信側  (ACCESS)

Option Compare Database
Option Explicit

'ウィンドウハンドル取得
Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" _
    (ByVal lpClassName As String, ByVal lpWindowName As String) As Long

'子ウィンドウハンドル取得
Private Declare Function FindWindowExA Lib "user32" _
    (ByVal hpar As Long, ByVal hchi As Long, ByVal cnm As String, ByVal cap As String) As Long
'メッセージ送信
Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" _
    (ByVal hWnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long

Private Const WM_COPYDATA = &H4A
Private Type COPYDATASTRUCT
    dwData As Long
    cbData As Long
    lpData As String
End Type


Function strSend()
    Dim hWnd As Long
    Dim sdtCOPYDATASTRUCT As COPYDATASTRUCT
    Dim txtSendData As String
    txtSendData = "ABCDEFG"

    Dim Ret As Long
    '送信データ格納
    sdtCOPYDATASTRUCT.dwData = 0
    sdtCOPYDATASTRUCT.cbData = LenB(txtSendData) + 1
    If Nz(txtSendData, "") = "" Then
        sdtCOPYDATASTRUCT.lpData = vbNullChar
    Else
        sdtCOPYDATASTRUCT.lpData = txtSendData  '送信データ
    End If
    '受信側のウィンドウハンドル取得
    hWnd = FindWindow(vbNullString, "フォーム名")

    If hWnd <> 0 Then
        Call SendMessage(hWnd, WM_COPYDATA, 0, sdtCOPYDATASTRUCT)
    End If

End Function


受信側  VB.NET

 'COPYDATASTRUCT構造体
    Public Structure COPYDATASTRUCT
        Public dwData As IntPtr   '送信する32ビット値
        Public cbData As Int32        'lpDataのバイト数
        Public lpData As String     '送信するデータへのポインタ(0も可能)
    End Structure
    Public Const WM_COPYDATA As Int32 = &H4A
    Public Const WM_USER As Int32 = &H400
    Protected Overrides Sub WndProc(ByRef m As System.Windows.Forms.Message)
        Select Case m.Msg
            Case WM_USER
                '数値が送信されて来た
                TextBox1.Text = m.WParam.ToString()
                'txtInt2.Text = m.LParam.ToString()
            Case WM_COPYDATA
                '文字が送信されて来た
                Dim mystr As COPYDATASTRUCT = New COPYDATASTRUCT()
                Dim mytype As Type = mystr.GetType()
                mystr = CType(m.GetLParam(mytype), COPYDATASTRUCT)
                TextBox1.Text = mystr.lpData
        End Select
        MyBase.WndProc(m)
    End Sub

Private Sub TextBox1_TextChanged(sender As System.Object, e As System.EventArgs) Handles TextBox1.TextChanged
’TextChangedイベントトラップを使って処理を実行
MessageBox.Show(Me.TextBox1.Text)

Me.TextBox1.Text = " "
End Sub

VBでしか動かせないものがある場合に使用出来ます。
VBフォームを予めOpenしておかなければならない点が我慢できるのであれば
選択肢として使えるのではないかと思います。