' IBM Personal Communication 用 IE 連動マクロ for VBScript Ver. 0.3

' written by Koichiro Hayashi, Dec. 2002

'

' 機能

' IEからPCOMへの値の転記作業をサポートする。IE・PCOMともに作業を行なう画面を

' 開いておき、PCOM側でこのマクロを実行するとIEから値が転記される。

'

' PCOM の VBScriptの仕様書は米IBMのサイトからダウンロードできる。ドキュメント

' 検索の画面で "Host Access Class Library" というタイトルを指定して出てきた

' 文書をダウンロードし、その中の "CHapter 3. Host Access Class Library

' Automation Object" の章を参照すること。

[PCOMM SCRIPT HEADER]

LANGUAGE=VBSCRIPT

DESCRIPTION=

[PCOMM SCRIPT SOURCE]

Option Explicit



' セッションをVBScriptから利用可能にする

autECLSession.SetConnectionByName(ThisSessionName)



' 値の受け渡しに使うグローバル変数の定義

Dim strContactPerson

Dim strContactFaxNo

Dim strContactPhoneNo



' mainサブルーチンの呼び出し(凝りすぎですか?)

main



' IEから値を取得し、それをClient Accessの画面にセットするメインルーチン

Public Sub main()



   autECLSession.autECLOIA.WaitForAppAvailable

   autECLSession.autECLOIA.WaitForInputReady

   

' Personal Communications の画面が目的の画面になっているかをタイトル文字列から判断

   Dim strScreenTitle

   strScreenTitle = autECLSession.autECLPS.getText(1,2,11)

   If strScreenTitle <> "DATA ENTRY " then

      MsgBox "You are not in BKG ENTRY screen. Please move to that screen and try again"

      Exit Sub

   End If



'IEから値を取得するサブルーチンを呼び出す

   If getValuesFromIE() > 0 Then

       Exit Sub

   End If



' 入力可能待ち → カーソルの移動 → 文字列の送信 というマクロの定番を繰り返す

   autECLSession.autECLOIA.WaitForInputReady

   autECLSession.autECLPS.SetCursorPos 2, 21

   autECLSession.autECLPS.SendKeys Left(strContactPerson, 17)

   

   autECLSession.autECLOIA.WaitForInputReady

   autECLSession.autECLPS.SetCursorPos 2, 65

   autECLSession.autECLPS.SendKeys Left(strContactPhoneNo, 15)

   

   autECLSession.autECLOIA.WaitForInputReady

   autECLSession.autECLPS.SetCursorPos 3, 65

   autECLSession.autECLPS.SendKeys Left(strContactFaxNo, 15)



End Sub



' 現在開かれているIEの画面から値を取り込み、グローバル変数にセットするサブルーチン

' あらかじめ目的の画面以外のエクスプローラ・IEを閉じておく必要がある

'

' 戻り値

'     正常に終了したら0、異常終了したら1

'

Public Function getValuesFromIE()



    Dim objIE, objDocument, objForm, objElement, strIEType

    

' もしもIEのインスタンスをGetObjectで取得できなければエラーを出して終了

    On Error Resume Next

        Set objIE = GetObject(, "InternetExplorer.Application")

        If IsEmpty(objIE) Then

            MsgBox "These seems no IE window.  Please open Pegasus Booking Summary Form before running this macro."

            getValuesFromIE = 1

            Exit Function

        End If

    On Error GoTo 0

    

' もしもIEでは無くエクスプローラを掴んでしまったらエラーを出して終了

    On Error Resume Next

        strIEType = ""

        strIEType = objIE.Type

        If strIEType <> "HTML Document" Then

            MsgBox "Now you open Windows Explorer. Please close all explorer windows other then Data Viewer Form and try again!"

            Set objIE = Nothing

            getValuesFromIE = 1

            Exit Function

        End If

    On Error GoTo 0



    objIE.Visible = True

    

' IEが動作中であれば動作が終了するのを待つ

    Do While objIE.Busy

        Sleep 100

    Loop



    Set objDocument = objIE.Document



' もしもTitleタグの値が期待する画面と異なっていればエラーを出して終了

    If objDocument.Title <> "Contact Data Viewer" Then

        MsgBox "Now you open other IE window(s). Please close all explorer windows other then Data Viwer Form and try again!"

        Set objIE = Nothing

        getValuesFromIE = 1

        Exit Function

    End If



' 目的とするエレメントについている番号が何番かは、以下のコードで確認できる

' (Debug.Print コマンドが入っているので Excel や Access で実行すること

'    For x = 0 To objDocument.all.length - 1

'        Set objElement = objDocument.all(x)

'        Debug.Print x, objElement.innerText

'    Next

    

' Documentオブジェクトを経由してエレメントの値を取得

    strContactPerson   = objDocument.all(12).innerText

    strContactFaxNo    = objDocument.all(17).innerText

    strContactPhoneNo  = objDocument.all(25).innerText

    Set ObjIE = Nothing

    

    getValuesFromIE = 0



End Function



' Sleep - 指定したミリ秒の間 Sleepする

' Client Access VBA では WinAPI の Sleep を使えないため、内蔵の Sleepコマンドで置き換えたもの

'

' 引数

'   Sleepする時間(ミリ秒単位)

' 戻り値

'   なし

Public Function Sleep(WaitMillSec)



    autECLSession.autECLPS.Wait WaitMillSec



End Function