[No.160 CODE BASE64の変換処理にチャレンジしてみた]
[No.161 Outlook VBAでフラグ作成 .FlagStatus .FlagRequest .FlagDueBy]
[No.162 IE データセット後、JavaScriptを起動する]
[No.163 IE _NewWindow2 別窓で開いたオブジェクトの管理]
[No.164 IE .getElementsByTagNameでタグ指定 .Quitで閉じる]

www.ken3.org(サイト内)から Google を利用して、

三流君 VBAで楽しくプログラミング(Excel/Access VBAの解説/サンプルです)
[VBA系のバックナンバー] [VBA系 TOP] [三流君 TOP]



No.160 2004/06/06
CODE BASE64の変換処理にチャレンジしてみた
[ページTOPへ戻る]

<CODE BASE64の変換処理にチャレンジしてみた>

どうも、三流プログラマーのKen3です。 今回は、 BASE64の変換処理にチャレンジしてみます。 http://www.ken3.org/vba/lzh/vba160.lzh にサンプルbase64test.xlsを圧縮しておきます、 Excel2000版ですが使ってみてください。

/* * 1.今回のキッカケ */

前回の No.159 IE 認証ページへのアクセス、basci認証ページって? http://www.ken3.org/vba/backno/vba159.html で、 設定したユーザーとパスワードの組み合わせ mailmaga:guest をBASE64変換して bWFpbG1hZ2E6Z3Vlc3Q= ヘッダーに指定 "Authorization: Basic bWFpbG1hZ2E6Z3Vlc3Q=" そして開いていました。 今回は、このBASE64のコードを探ってみたいと思います。

/* * 2.BASE64って何? */

BASE64って何?私の知識でこの単語が引っかかるのは、 メールで添付フアイルを送る時、BASE64って単語を見たことがある程度です。 よし、Yahoo と Googleで探してみるか。(最近検索結果が違うので探りを兼ねて) GoogleでBASE64をキーワードに探すと、 http://www.google.co.jp/search?hl=ja&ie=UTF-8&q=BASE64&lr=lang_ja (日本語のページを探しました) BASE64とは何か : IT用語辞典 ─ 用語解説 ─ 意味 ... http://e-words.jp/w/BASE64.html が一番上に出てきます。(2004/6/6現在) う〜ん、ここは用語説明でした、、、 上から3つ目に、 BASE64 について http://www.sea-bird.org/doc/Cygwin/BASE64enc.html とサイトがあり、 >1.エンコードすべきデータから、3バイト取得する。 >2.取得した3バイトを24ビットのデータ領域に設定する。 >3.上位から6ビットを取り出し、その数値を下記の変換テーブルに従い >キャラクター文字に変換する。 >4.次の6ビット以降も同じ変換を行い、24ビットすべて変換する。 >5.エンコードすべきデータが無くなるまで、1〜4の作業を繰り返す。 > ※エンコードすべきデータが、2バイトしか無い場合は、それまでBASE64 >エンコード変換した文字列の最終位置に'='を付加する。 > ※エンコードすべきデータが、1バイトしか無い場合は、それまでBASE64 >エンコード変換した文字列の最終位置に'=='を付加する。 > >変換テーブル:6ビットデータの「0〜63」を以下の文字列に変換する。 > 0 〜25:A〜Z > 26〜51:a〜z > 52〜61:0〜9 > 62 :+ > 63 :/ と、丁寧に変換方法が載ってました。 YahooでBASE64を検索しても、いろいろなページがヒットします。 http://search.yahoo.co.jp/bin/query?p=BASE64&hc=0&hs=0 読んでいくと、 6ビット単位にデータを取り出し、それを指定された文字に当てはめる。 って感じです。

/* * 3.さっそく作ってみた */

手抜きで、漢字2バイトには対応していないが、 下記のように作ってみました。 ※なんか無駄に長いんだけど、気にしないでね。 'BASE64の変換処理にチャレンジする 全角文字未対応
Function base64(strMOJI As String) As String

    Dim strWORK As String
    Dim strCODE As String
    Dim n As Integer, i As Integer
    Dim nAMARI  As Integer
    Dim n6BOX(5) As Integer  '6ビット取り出した数値
    Dim nCODE As Integer
    Dim strRET As String
    
    strRET = ""  'リターン値を初期化する
    
    For n = 1 To Len(strMOJI) Step 3
        '3バイトを2進数に変換する、24ビットの数値を作成する
        strWORK = ""
        nAMARI = 0
        For i = 0 To 2
            strCODE = Mid(strMOJI, n + i, 1) '文字を取り出す
            If strCODE = "" Then
                nAMARI = 3 - i
                strWORK = strWORK & "00000000"
                Exit For
            Else  'コードに変換する
                strWORK = strWORK & HEX16toSTR2(Hex(Asc(strCODE)))
            End If
        Next i

        Debug.Print strWORK
        '8*3の24ビット2進数から6ビット単位で4つ取り出し、数値に変換する
        For i = 0 To 3
            n6BOX(i) = Val("&H0" & STR2toHEX16(Mid(strWORK, 1 + i * 6, 6)))
            Debug.Print n6BOX(i)
        Next i
        '対応表にそって変換する
        '6ビットデータの「0〜63」を以下の文字列に変換する。
        '  0 〜25:A〜Z
        '  26〜51:a〜z
        '  52〜61:0〜9
        '  62    :+
        '  63    :/
        For i = 0 To 3 - nAMARI
            If n6BOX(i) = 63 Then strRET = strRET & "/"
            If n6BOX(i) = 62 Then strRET = strRET & "+"
            '  0 〜25:A〜Z
            If 0 <= n6BOX(i) And n6BOX(i) <= 25 Then
                strRET = strRET & Chr(Asc("A") + n6BOX(i) - 0)
            End If
            '  26〜51:a〜z
            If 26 <= n6BOX(i) And n6BOX(i) <= 51 Then
                strRET = strRET & Chr(Asc("a") + n6BOX(i) - 26)
            End If
            '  52〜61:0〜9
            If 52 <= n6BOX(i) And n6BOX(i) <= 61 Then
                strRET = strRET & Chr(Asc("0") + n6BOX(i) - 52)
            End If
        Next i
        'あまりの文字分=を追加する
        If nAMARI = 1 Then strRET = strRET & "="
        If nAMARI = 2 Then strRET = strRET & "=="
    Next n

    base64 = strRET

End Function
'2進文字列を受け取り16進文字列を返す
Function STR2toHEX16(ByVal str2 As String) As String

    Dim strHEX As String
    Dim n As Integer      'ループカウンタ
    Dim i As Integer      'ループのカウンタ
    Dim n8421 As Integer  '8 4 2 1の数値計算用
    Dim nBYTE As Integer

    '頭4文字単位かチェックする
    n = Len(str2) Mod 4      '足りない文字数を計算する
    If n <> 0 Then
       str2 = String(4 - n, "0") & str2 '頭に文字0を追加する
    End If

    strHEX = ""   '結果のエリアを初期化する

    '文字数分ループする
    For n = 1 To Len(str2) Step 4  '4文字(1バイト)単位にループを作る
        n8421 = 8  '初期値に8を代入する(上から計算したいので)
        nBYTE = 0  '1バイト計算用変数を初期化
        For i = 0 To 3  '4回まわるよ(4ビット分)
            'ビットが立っているかチェックする
            If Mid(str2, n + i, 1) = "1" Then
                nBYTE = nBYTE + n8421   'ビットに対応した数値を+する
            End If
            '次のビットを計算したいので2で割る
            n8421 = n8421 / 2
        Next i
        '計算して、1倍との数値が完成したので16進文字にしてセットする
        strHEX = strHEX & Hex(nBYTE)
     Next n

     'リターン値をセットして関数を抜ける
     STR2toHEX16 = strHEX

End Function
'HEX16進文字列を受け取り2進文字列を返す
Function HEX16toSTR2(strHEX As String) As String

    Dim n As Integer      'ループカウンタ
    Dim i As Integer      'ループのカウンタ
    Dim n8421 As Integer  '8 4 2 1の数値計算用
    Dim str2STR As String
    
    Dim nCHK As Integer
    
    str2STR = ""  '結果のエリアを初期化する

    '文字数分ループする
    For n = 1 To Len(strHEX)
        nCHK = CInt("&h" & Mid(strHEX, n, 1)) 'n文字目を数値変換
        n8421 = 8  '初期値に8を代入する(上からチェックしたいので)
        For i = 1 To 4  '4回まわるよ
            If (nCHK And n8421) = 0 Then 'Andでビットをチェックする
                str2STR = str2STR & "0"  'ビットは立ってないよ
            Else
                str2STR = str2STR & "1"  'ビットは立ってるよ
            End If
            '次のビットをチェックしたいので2で割る
            n8421 = n8421 / 2
        Next i
     Next n

     'リターン値をセットして終了
     HEX16toSTR2 = str2STR

End Function
ポイントは、特に無いけど(工夫をしないでダラダラと作ってしまった・・・) ASP系で使った、 2進数文字列を受け取りHEX16進文字列を返す(頭0を+する) http://www.ken3.org/cgi-bin/test/test094-2.asp?DATA=111 と 16進数文字列を2進数文字列へ変換 http://www.ken3.org/cgi-bin/test/test094-1.asp?DATA=F2 を流用して 16進<−−>2進の文字列をやり取りしてます。 ※この変換プログラムのバカな作成秘話は、 愚痴系No.197 テストデータは汚いデータで?(都合の悪いデータで) http://www.ken3.org/guchi/backno/guchi197.html ↑を見て笑ってください・・・ダメだこりゃ・・・ 今回のプログラムの説明に戻ると、 For n = 1 To Len(strMOJI) Step 3 で、3文字単位のループを作り(Step3で3文字飛ばす) '3バイトを2進数に変換する、24ビットの数値を作成する strWORK = "" nAMARI = 0 For i = 0 To 2 strCODE = Mid(strMOJI, n + i, 1) '文字を取り出す If strCODE = "" Then nAMARI = 3 - i strWORK = strWORK & "00000000" Exit For Else 'コードに変換する strWORK = strWORK & HEX16toSTR2(Hex(Asc(strCODE))) End If Next i 上記で、24ビット8ビット*3の2進数文字列を作成し、 そこから、6ビット単位でデータを取り出し、再び数値に変換。 Debug.Print strWORK '8*3の24ビット2進数から6ビット単位で4つ取り出し、数値に変換する For i = 0 To 3 n6BOX(i) = Val("&H0" & STR2toHEX16(Mid(strWORK, 1 + i * 6, 6))) Debug.Print n6BOX(i) Next i ここまでで、6ビット単位の4つの数値が完成する。 で、その数値を、対応表にしたがって、文字に直します。 '対応表にそって変換する '6ビットデータの「0〜63」を以下の文字列に変換する。 ' 0 〜25:A〜Z ' 26〜51:a〜z ' 52〜61:0〜9 ' 62 :+ ' 63 :/ For i = 0 To 3 - nAMARI If n6BOX(i) = 63 Then strRET = strRET & "/" If n6BOX(i) = 62 Then strRET = strRET & "+" ' 0 〜25:A〜Z If 0 <= n6BOX(i) And n6BOX(i) <= 25 Then strRET = strRET & Chr(Asc("A") + n6BOX(i) - 0) End If ' 26〜51:a〜z If 26 <= n6BOX(i) And n6BOX(i) <= 51 Then strRET = strRET & Chr(Asc("a") + n6BOX(i) - 26) End If ' 52〜61:0〜9 If 52 <= n6BOX(i) And n6BOX(i) <= 61 Then strRET = strRET & Chr(Asc("0") + n6BOX(i) - 52) End If Next i ↑オイオイって感じのIf文の羅列ですがご勘弁を。 ↓変換文字が余っていたら=をプラスしてます。 'あまりの文字分=を追加する If nAMARI = 1 Then strRET = strRET & "=" If nAMARI = 2 Then strRET = strRET & "==" Next n と、こんな感じで、3文字単位で変換しました。 ※漢字には非対応なので、2バイト文字を使う人は、一工夫してくださいね。

/* * 4.処理を組み込む */

さて、BASE64の変換処理ができたので、前回のソースに組み込んでみます。 Dim strHEAD As String 'ID:passwordをBASE64変換してヘッダ情報を作成する strHEAD = "Authorization: Basic " & base64("mailmaga:guest") & vbCrLf として、ヘッダ情報を作ってみました。 ※フト、ここにIDとパスワード書いたら丸見えですね(オイオイ) 別な問題があると思いつつ、、、 'BASE64でユーザーID:パスワードを変換して開く
Sub bbbb()

    Dim objIE As Object 'IEオブジェクト参照用
    
    'インターネットエクスプローラーのオブジェクトを作る
    Set objIE = CreateObject("InternetExplorer.application")
    objIE.Visible = True '見えるようにする(お約束)
    
    'テスト用の認証ページに飛ぶ
    Const strURL = "http://www.kurokiya.sake-ten.jp/zzz/"
    Dim strHEAD As String
    
    'ID:passwordをBASE64変換してヘッダ情報を作成する
    strHEAD = "Authorization: Basic " & base64("mailmaga:guest") & vbCrLf
    
    objIE.navigate2 strURL, , , , strHEAD
    
    '表示終了まで待つ
    Do While objIE.Busy = True
        '何もしないループ(笑)
        DoEvents
    Loop

    'テストでHTMLソースを取出す
    Dim strhtml As String
    strhtml = objIE.Document.all(0).innerHTML  '変数に代入
    MsgBox "ソースは" & strhtml & "です"

End Sub

/* * 5.終わりの挨拶 */

BASE64の変換もどきを作ってみました。 でも、パスワードをVBAに埋め込んでおくとキケンだと感じたり・・・ あっ、逆のデコードも書かなきゃ(と将来のネタを残しつつ) http://www.ken3.org/vba/lzh/vba160.lzh にサンプルbase64test.xlsを圧縮しておきます、 Excel2000版ですが使ってみてください。 何か読者の心に残れば、うれしいです。 *私の独り言をうまく消化してくださいね。 いつも失敗?の負け組のKen3でした。 ~~~~~~~(↑オイオイ)

No.161 2004/06/09
Outlook VBAでフラグ作成 .FlagStatus .FlagRequest .FlagDueBy
[ページTOPへ戻る]

<Outlook VBAでフラグ作成 .FlagStatus .FlagRequest .FlagDueBy>

どうも、三流プログラマーのKen3です。 今回は、 Outlookのメールで、フラグの作成にチャレンジしてみます。 http://www.ken3.org/vba/lzh/vba161.lzh にサンプルoutlookFLG.xlsを圧縮しておきます、 Excel2000とOutlook2000版ですが使ってみてください。 三流君VBAでOutlookを操作する http://www.ken3.org/cgi-bin/group/vba_outlook.asp 上記関連リンクももよろしくね。 /* * 1.今回のキッカケ */ 掲示板に下記のメッセージを貰いました。 ------ > No.55 Outlookを操作してメールを送りたい を参考に、選択したメール本文を >引用したメールを作成するマクロにチャレンジし、無事、動作することができま >した。 > しかし、その引用したメール作成処理を行ったかどうかが判らなくなってしまう >ため、現在は処理を行った元メールに手作業でフラグを付けている状態です。 > その為、フラグを付け忘れてしまうこともあり、この手作業をマクロで組みたい >のですがご教授お願いいたします。 ------ ご教授お願い〜は、基本的に嫌いなフレーズなんだけど、、、 (※なんか掲示板で偉そうにしている人達が好きそうなフレーズなので私は嫌いです) なんて愚痴系( http://www.ken3.org/guchi/ 参照)みたいなこと言ってないで、 アウトルックのメールのフラグ関係 を 今回は私の攻略法含めて進めてみます。 (本文無駄に長いので拾い読みしてください) /* * 2.Outlookのオブジェクトの探り方 */ これも、私の我流な三流的攻略法だけど、 Outlookのオブジェクトの探り方は、 Outlookを起動します。 ^^^^^^^^^^^^^^^^^^^^^ 起動後、Alt+F11を押します。 すると、VBAのいつものよく見かける画面が表示されます。 ※ExcelやAccessで参照設定したあとでもOKです。 ここで、探りたいオブジェクトの適当な変数を定義します。 Dim aa as とか入力すると、なんと、mailitemとか出てきます。 http://www.ken3.org/backno/gif/vba101-01.gif ↑オブジェクトの変数が表示された例 そこで、 Dim aa as MailItem と、メールのアイテム型の変数を定義します。 ※これは、オブジェクト名前とかで狙いを付けて、 まぁ、失敗してもやり直すって感じで。 (女性をデートの誘う時もこれくらい気軽に?できたらいいね(オイオイ)) 次は、狙いをつけた女性の身に付けているブランド品や行動パターンじゃなくって、 あたりをつけた、オブジェクトのプロパテイやメソッドを探ります。 ここは、いきなりアタックって感じで、 Dim aa as MailItem と定義してから、aa.とaaさんにアタックします。 すると、プロパティやメソッドが表示されるので、 それらしいプロパティ・メソッドの名称を選択します。 おっ、aaさんの行動は(メソッドは)これだとか、 ここも経験や当てずっぽうに推理します。 ※出たとこ勝負もアリでしょう or パターンでなんとなくわかったり・・・ http://www.ken3.org/backno/gif/vba101-02.gif ↑MailItemの.FlagStatus フラグのステータスを探して、選択したところです。 次は、そのプロパティにカーソルを合わせ、F1のヘルプを見る。 あれれ・・・ハズシタ(笑)フリダシニ戻る や OK、目的のプロパティ、メソッドだった、となります。 探り方、まとめるとこんな感じで、 該当するオブジェクト型の変数を定義 Dim aa as MailItem その後、 aa. と、候補を表示させ、それらしいのにアタック。 aa.FlagStatus と選択後、カーソルを合わせてからF1のヘルプを見る。 そんな流れでいつもVBAのプロパティ、メソッドを探ってます。 ※もっと効率の良い、 女の子(オブジェクト)へのアタック方法もあるんだろうけど・・・ あとは、世の中のチャラ男やナンパ男の成功例を見て自分も真似したいので、 GoogleやYahooで探したプロパティ、メソッドをキーワードにして事例を検索します。 すると、 .xxxxx プロパティはひどい女だったよ、 期待させておいてボッタクリのバグかよ・・・ とか 口説き落とすテクや扱い方の注意事項が載ってます。 まぁ、そのまま真似してもいいし、アレンジしてもいいし。 /* * 3.Flag関係のプロパティを探ってサンプルを作成 */ Flag関係のプロパティを探って、F1でヘルプをみたりして、 サンプルを作成してみました。 Flag***と付いたプロパティを表示させて、F1を押していきます。 objMailItem.FlagDueBy >このメッセージのアクションに設定されている期限を設定します。 おっと、期限かぁ、 objMailItem.FlagRequest は、 >メッセージに対して要求されたアクションを設定します。 >このプロパティは、自由形式のテキスト フィールドです。 だってさ objMailItem..FlagStatus プロパティ >フラグを設定します。使用できる定数は、 >OlFlagStatus クラスの >olFlagComplete (1)、olFlagMarked (2)、および olNoFlag (0) >のいずれかです。 >値の取得および設定が可能です。長整数型 (Long) の値を使用します。 ヘルプを見ると通常はサンプルがついているので、 それを参照するのが正攻法で早いんだけど、 今回のflg***系はサンプルが無かったです・・・ サンプル無いのはツライケド、だいたいの攻略イメージは、 .FlagStatus プロパティ に olFlagMarked (2) フラグ作成(Marked)を立てる。 .FlagRequest にメッセージをセットする。 .FlagDueBy は 期限 これをセットしていけばいいのかな。 なんとか、作成したサンプルです。 Sub test送信メール作成() Dim oApp As Object 'アプリケーションオブジェクト Dim objMAIL As Object 'メールのオブジェクト Dim strMOJI As String '本文 'アプリケーションオブジェクトの作成 Set oApp = CreateObject("Outlook.Application") Set objMAIL = oApp.CreateItem(0) 'olMailItem=0 strMOJI = "こんにちは" & vbCrLf _ & "ジッタリンジンのCD返してください" & vbCrLf _ & "よろしくお願いします" objMAIL.To = "test@ken3.org" '宛先 objMAIL.Subject = "TEST Mail CD返してください" '件名 objMAIL.Body = strMOJI '本文の代入 'VBA161でFLG関係のテスト objMAIL.FlagStatus = 2 'olFlagMarked (2)をセット参照設定時は定数で objMAIL.FlagRequest = "CD返却の件連絡ください" 'フラグ内容をセット objMAIL.FlagDueBy = DateAdd("d", 5, Now) '期限は5日後をセット '↑ここまです(VBA161で追加) objMAIL.Display '途中で編集したい時(メール表示してみた) 'おまけでOutlook表示 Dim myNameSpace As Object Dim myFolder As Object Set myNameSpace = oApp.GetNameSpace("MAPI") Set myFolder = myNameSpace.GetDefaultFolder(6) '規定のフォルダーを指定 myFolder.Display '表示 End Sub サンプルの実行結果は↓ http://www.ken3.org/backno/gif2/vba161-02.gif です。 今回のポイントは、 ^^^^^^^^^^^^^^^^^^ objMAIL.FlagStatus = 2 'olFlagMarked (2)をセット参照設定時は定数で objMAIL.FlagRequest = "CD返却の件連絡ください" 'フラグ内容をセット objMAIL.FlagDueBy = DateAdd("d", 5, Now) '期限は5日後をセット の3行です。 単に調べたプロパティに値をセットしただけでした。 objMAIL.FlagStatus = 2 と直値で2をセットしてますが、参照設定していれば、 objMAIL.FlagStatus = olFlagMarked が正しい書き方です。 /* * 4.終わりの挨拶 */ 今回は、 Outlook VBAのオブジェクトの攻略方法 と メールへのフラグ設定サンプルでした。 http://www.ken3.org/vba/lzh/vba161.lzh にサンプルoutlookFLG.xlsを圧縮しておきます、 Excel2000とOutlook2000版ですが使ってみてください。 三流君VBAでOutlookを操作する http://www.ken3.org/cgi-bin/group/vba_outlook.asp 上記Outlook関連リンクももよろしくね。 何か読者の心に残れば、うれしいです。 *私の独り言をうまく消化してくださいね。 はぁ〜、誰か私に女性の攻略方法教えてよと独り言を書きつつ、 人に聞く前に自分で少しは努力したのかよって読者の心の声をすぐに聞きつつ ヒキコモリの在宅三流プログラマー Ken3でした。 ~~~~~~~(↑オイオイ)

No.162 2004/06/10
IE データセット後、JavaScriptを起動する
[ページTOPへ戻る]

<IE データセット後、JavaScriptを起動する>

どうも、三流プログラマーのKen3です。 今回は、 IE操作で、フォームにデータセット後、 JavaScriptを起動する、そんな処理を行ってみたいと思います。

/* * 1.今回のキッカケ */

本を売って、小金を儲けよう、、、そんな不純な心の動きで、 amazon.com と 楽天ブック に 申し込みました。 商品個別リンクがあって、個別の商品リンクを作成できるみたいです。 この、個別リンクの作成にチャレンジしてみたいと思います。 楽天ブックで個別リンクを作るには、 http://books.rakuten.co.jp/afvc/afinfo/page03.html のページに、 紹介したい本のISBN番号 と 自分の広告コード SIDとPIDを入力して 作成ボタンを押すと、作成されます。 ExcelのVBAから、Webブラウザコントロールを使って、データをセットしてみます。

/* * 2.動作の仕組みを探る */

http://books.rakuten.co.jp/afvc/afinfo/page03.html のhtmlを探ると、 form name=parts input type="text" name="isbn" input type="text" name="sid" input type="text" name="pid" となっていて、 ソースの表示ボタンは、 <a href = "JavaScript:parts('A')"> や <a href = "JavaScript:parts('B')"> とjavascriptで処理となってます。 ボタンが押され、 JavaScript:parts('B')処理が走ると、 新規のウインドウに、広告用のソースコードが表示される、 そんな仕組みとなってます。

/* * 3.仕様を簡単に書く */

フォームを作成して、ISBN番号、SID,PIDを入力させます。 SID [ ] ← 設定用のシートからデフォルトを表示する PID [ ] ← 設定用のシートからデフォルトを表示する ISBN [ ] ← 目的の番号を入力する 広告 [ ] ← 複数行のテキストボックスを作成して、 ・ 広告用のソースを表示させる     ・ [ ] 作成ボタン ボタンが押されたら、 リンク作成ページへ飛び、データをセットして、 リンク作成ボタンを押す(javascriptをVBAから起動) 広告コード用の新規のウインドウが表示される。 そのウインドウから、広告コードを取り出し、 テキストボックスにセットする。 セット完了後、広告作成のweb表示・ブラウザを閉じる。 こんな感じの流れで、 フォームにパラメータセット、 データ送信 サーバー側でコード作成 結果のソースコードを取得 を行ってみたいと思います。

/* * 4.問題点、技術確認 */

処理やデータの流れを整理したら、 次は、 予想される問題点を整理します。 技術的に可能か?それとも不可能か? 仕様を聞いて、不安になった部分は?ありますか? なんて感じで自分に自問自答しながら、項目をまとめていきます。 仕様書からプログラムを起こす前準備で、 ・イメージが湧き出してすぐにでも作れそうと感じるか、 ・それとも、不安になるか、、、 ここのファーストタッチが重要だと思います。 ※性格的にいつも不安な担当者 や 根拠の無い自信がある担当者も居るんだけど。 今回の処理を私なりにまとめたポイントは、 webのコントロールにデータをセット可能か?  → 過去やったことがある(経験がある自信あるし、ここは大丈夫と答えられる) webのjavascriptをVBAから起動できるのか?  → 過去、ボタンのコントロールに対して、    .Clickメソッドでやったことあるが    指定した関数をパラメータ付きで起動したことは無い    ※技術的にできることを早急に確認する webのコントロールから作られたウインドウのデータを取得できるか?  → javascriptでopenされた結果の表示(新規ウインドウ)    からデータを取得可能か and 取得方法を調べる など、仕様書(やりたいこと) から 予想される問題点を洗い出します。 あとは、その問題点をまず、簡単なテストでつぶします。 つぶしきれなかったら、仕様を変えてもらうなどの処理が必要です。 よくある話ですが、 夢のような仕様なのか、現実的な仕様なのか作成に入る前に判断します。 不安を先送りにすると、ロクナコト無いですよ。 また、よく掲示板で目にする話なのですが、 XXXXはできるのでしょうか?事前調査で知りたい って書き込みかなぁ。これもアリでしょう。 ※実際の問題点やソースを開示しろと言われてる場面も見かけるが。 チョット内容が違うけど、愚痴系のメルマガで、 No.138 アイツが打てたから、オレも打てる。マシンガン打線 http://www.ken3.org/guchi/backno/guchi138.html なんて書いてます、 実現可能な仕様 や 過去に経験者が居ると安心だよね。

/* * 5.IE データセット後、JavaScriptを起動する */

楽天ブックのリンク作成ページ http://books.rakuten.co.jp/afvc/afinfo/page03.html ここで、 ISBN番号 と 自分の広告コードのSIDとPIDを入力してボタンを押すと ソースが表示される。 ソースを探ると、 form name=parts フォームの名前はpartsかぁ、 input type="text" name="isbn" input type="text" name="sid" input type="text" name="pid" と入力フォームがなっていて、 a href = "JavaScript:parts('A') a href = "JavaScript:parts('B') ・ ・ a href = "JavaScript:parts('F') a href = "JavaScript:parts('L') a href = "JavaScript:parts('M') a href = "JavaScript:parts('S') とサイズ別にJavaScriptを起動しているみたいです。 そこで、プログラム作成の手順としては、 ExcelUserフォームにISBN,SID,PIDの入力を作成する。 実行ボタンが押されたら、 http://books.rakuten.co.jp/afvc/afinfo/page03.html へ飛び、表示の終了を待ってから、 Webコントロール上のform name=partsのテキストボックスにデータをセットする。 JavaScript:parts('B')を起動させ広告を表示させる。 ※サイズBの広告データを作成します。 テストデータは、 ISBN:4797321296 基礎からのデータベース設計 SID=777777 PID=99999999 をセットして、実行してみます。 サイズBのボタンを探して、.Clickといつもの方法でも良かったのですが、 今回は、JavaScriptの起動方法を探してみました。 IEのJavaScriptの起動方法ですが、 ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^ ? Me.WebBrowser1.Document.scripts(1).scopeName とか、scriptsがスクリプトオブジェクトだから、 これを.RUNとかないかなぁと探ってみましたが、 目的の処理が見つかりませんでした。 チョット違うかもしれないけど、今回は、 画像がクリックされたらのAタグだったので、 'JavaScriptを起動する(リンクで飛ぶように見せかけるの?) Me.WebBrowser1.Navigate2 "JavaScript:parts('B')" とすることで、JavaScriptを起動できたことでした。 なんか意外でした・・・ <a href = "JavaScript:parts('B')">〜 となっているから、それだったら、 .Navigate2 "JavaScript:parts('B')" でOKなのか?って発想でテストしてみました。
Private Sub btnRUN_Click()

    Dim time10  As Date

    '広告作成ページに飛ぶ
    Me.WebBrowser1.Navigate2 "http://books.rakuten.co.jp/afvc/afinfo/page03.html"

    '2秒表示を強制的に待つ
    time10 = DateAdd("s", 2, Now())
    Do While True
        DoEvents
        If time10 < Now() Then Exit Do
    Loop

    '表示完了を待つ
    While Me.WebBrowser1.Busy = True _
           Or Me.WebBrowser1.ReadyState <> READYSTATE_COMPLETE
        DoEvents
    Wend

    'データをセットする
    Me.WebBrowser1.Document.parts.isbn.Value = Me.txtISBN.Text
    Me.WebBrowser1.Document.parts.sid.Value = Me.txtSID
    Me.WebBrowser1.Document.parts.pid.Value = Me.txtPID

    'JavaScriptを起動する(リンクで飛ぶように見せかけるの?)
    Me.WebBrowser1.Navigate2 "JavaScript:parts('B')"

End Sub
こんな感じで、データセット、JavaScriptの起動までいきました。 さてと、次は、開らかれた新規ウインドウから、広告ソースデータをGetしないと。

/* * 6.終わりの挨拶 */

http://www.ken3.org/p/o20040515.lzh に webdataset.xlsが圧縮されてます。 処理が中途半端ですが、テストしてみてください。 何か読者の心に残れば、うれしいです。 *私の独り言をうまく消化してくださいね。 ヒキコモリの在宅三流プログラマー Ken3でした。 ~~~~~~~(↑オイオイ)

No.163 2004/06/11
IE _NewWindow2 別窓で開いたオブジェクトの管理
[ページTOPへ戻る]

<IE _NewWindow2 別窓で開いたオブジェクトの管理>

どうも、三流プログラマーのKen3です。 今回は、 リンクを右ボタンで新しいウインドウで開く や Target=_Blank など 親ウインドウから子供のウインドウが開かれた時の管理について少し書きます。 IE操作で、何かの参考となれば、幸いです。

/* * 1.今回のキッカケ */

右ボタンなどを押して、新しいウインドウをユーザーの意思で開くことができます。 まぁ、マルチにウインドウを開いて処理を行う、普通のことなのですが、 Webコントロールをフォームに貼ったりして作業していると、 自分(自作プログラム)の配下から離れてしまいます。 そんなことをさせなかったり、 されても、作られたオブジェクトを追ってみたいと思います。 WebBrowser1 とWebのコントロールを作ります。 WebBrowser1_NewWindow2で、新しいウインドウが開かれた時のイベントを受取れます。 これを使用してみます。

/* * 2.新しいウインドウが開く時に発生するイベント_NewWindow2 */

新しいウインドウが開かれると発生するイベントがあります。 IE アプリケーションのイベントを横取りする http://www.ken3.org/vba/backno/vba108.html で、少し、_NewWindow2とWithEventsについて書いてあります、 こちらも合わせて確認してください。 WebBrowserコントロールをフォームに貼り、 下記のプログラムを記述し テストで、初期ページを表示させ、どこかのリンクで新しいウインドウを開きます。
Private Sub UserForm_Initialize()
    Me.WebBrowser1.GoHome  '初期ページを表示する
End Sub
Private Sub WebBrowser1_NewWindow2(ppDisp As Object, Cancel As Boolean)
    '新しいウインドウが開かれた時に呼ばれる。
    If MsgBox("新しいウインドウを開きますか?", vbYesNo) = vbYes Then
        Cancel = False    'Yesの時はキャンセルしない
    Else
        Cancel = True     'NOの時は新しいウインドウを開かない
    End If
End Sub
開かれると、_NewWindow2が呼ばれます。 ここでは、 引数のキャンセルの動きと関数の呼ばれるタイミングをチェックしたかったので、 MsgBox("新しいウインドウを開きますか?", vbYesNo) とメッセージ表示後、Yes,Noを判断して、 Cancelの動きをチェックしてみました。 Cancel = Trueとすると、新しいウインドウのオープンをキャンセル(中止)できます。 下記のように、必ず開かせない、そんなこともできます。
Private Sub WebBrowser1_NewWindow2(ppDisp As Object, Cancel As Boolean)
    Cancel = True     '必ず新しいウインドウを開かない
End Sub

/* * 3.IE 新しいウインドウを作り オブジェクトを横取り */

開くタイミングはわかったけど、やりたいのは開かれた新規IEの管理でしょ。 作られたウインドウを自分で管理したいと思います。 ※自分でオブジェクトをコントロールしたいんです。 まず、Dim WithEvents で 変数を作成します。 下記、簡単なテストプログラムです。 Dim WithEvents objNEW_IE As InternetExplorer
Private Sub UserForm_Initialize()
    Me.WebBrowser1.GoHome  '初期ページを表示する
End Sub
Private Sub WebBrowser1_NewWindow2(ppDisp As Object, Cancel As Boolean)

    Set objNEW_IE = CreateObject("InternetExplorer.Application")
    Set ppDisp = objNEW_IE  '作ったオブジェクトを代入

    objNEW_IE.Visible = True

End Sub
Private Sub objNEW_IE_DocumentComplete(ByVal pDisp As Object, URL As Variant)
    MsgBox "あたらしく開かれたURLは" & URL
End Sub
ポイントは、まず、 Dim WithEvents objNEW_IE As InternetExplorer と、イベントを横取りできるようなオブジェクトの入れ物を定義します。 次に、 WebBrowser1_NewWindow2 の新規ウインドウが開かれた時に発生するイベント内で、 Set objNEW_IE = CreateObject("InternetExplorer.Application") と、 新しいIEを自分で作成し(Createして)、Dim WithEventsで定義した変数に代入します。 次に、その変数を Set ppDisp = objNEW_IE '作ったオブジェクトを代入 に代入します。 この代入で、新しいウインドウ=作られたウインドウになります。 あとは、 objNEW_IE.Visible = True で見えるようにしました。 テストで、 新しく開かれたウインドウの読み込み終了のイベント_DocumentCompleteで、 URLを表示させてみました。
Private Sub objNEW_IE_DocumentComplete(ByVal pDisp As Object, URL As Variant)
    MsgBox "あたらしく開かれたURLは" & URL
End Sub

/* * 4.応用して、新規ウインドウのソースを表示してみた */

開かれたウインドウ(新規IE)のオブジェクトの取得ができました。 取得と言うよりも、自分で作成したオブジェクトを使った、そんな感じです。 ここから、 データ入力後に、新規のウインドウが開く、Webシステムに対応したい ので、とっかかりとして、新しく開いたIEのソースを表示してみます。 前回の広告コード作成と合わせて、本の紹介コードを作ってみます。 起動のソースは、前回のままです。 ここでは、フォームに設置したWebのコントロールに対して、 .Navigate2でページ移動、 .Documentに対してデータをセットして、 .Navigate2 "JavaScript:parts('B')"でJavaScriptを起動してます。
Private Sub btnRUN_Click()

    Dim time10  As Date

    '広告作成ページに飛ぶ
    Me.WebBrowser1.Navigate2 "http://books.rakuten.co.jp/afvc/afinfo/page03.html"

    '2秒表示を強制的に待つ
    time10 = DateAdd("s", 2, Now())
    Do While True
        DoEvents
        If time10 < Now() Then Exit Do
    Loop

    '表示完了を待つ
    While Me.WebBrowser1.Busy = True _
           And Me.WebBrowser1.ReadyState <> READYSTATE_COMPLETE
        DoEvents
    Wend

    'データをセットする
    Me.WebBrowser1.Document.parts.isbn.Value = Me.txtISBN.Text
    Me.WebBrowser1.Document.parts.sid.Value = Me.txtSID
    Me.WebBrowser1.Document.parts.pid.Value = Me.txtPID

    'JavaScriptを起動する(リンクで飛ぶように見せかけるの?)
    Me.WebBrowser1.Navigate2 "JavaScript:parts('B')"

End Sub
こんな感じで、IE新規ウインドウが開き、ソースの表示までいきました。 さてと、開いたウインドウから、テキストデータをGetしないとね。 新しく開いたウインドウを管理化に置きたいので、 '自分で新規のウインドウをコントロールしたいので、 Dim WithEvents objNEW_IE As InternetExplorer とイベントを取れるオブジェクト型のグローバル変数を1つ作成します。 次に、フォームに貼った、 webのコントロールで、新しいウインドウが開かれた時に、 開くウインドウに勝手に自分で作成したオブジェクトをセットします。 '新しいウインドウを開くイベントをチェックする
Private Sub WebBrowser1_NewWindow2(ppDisp As Object, Cancel As Boolean)

    '新しいウインドウを自分の管理下に置きたいので、オブジェクトを代入してあげる
    Set objNEW_IE = CreateObject("InternetExplorer.Application")
    Set ppDisp = objNEW_IE   '作ったオブジェクトを代入

    objNEW_IE.Visible = True '念のため見えるようにする

End Sub
こんな感じで、WebBrowser1コントロールの_NewWindow2のイベントで、 自分で新たに作成したIEオブジェクトをグローバルに代入、 さらに、 Set ppDisp = objNEW_IE と 新しく開くウインドウにも指定します。 すると、新しく開かれたIE=自分の管理化のobjNEW_IE変数となります。 あとは、 Dim WithEvents objNEW_IE As InternetExplorer とイベントを取れる宣言しているので、 テストで、URLとソースを表示してみました。 '新しく作成したウインドウが読み込まれたら、処理したいので、
Private Sub objNEW_IE_DocumentComplete(ByVal pDisp As Object, URL As Variant)
    MsgBox "あたらしく開かれたURLは" & URL
    MsgBox "HTMLソースは" & objNEW_IE.Document.all(0).innerhtml
End Sub
こんな感じで、JavaScriptで新しく開かれたIEのソースを取得できそうです。 なんて書いてますが、 実行してみるとわかりますが、 objNEW_IE_DocumentComplete のイベントが2回走ってます。 ここも細工して、広告コードを取得したら、 自動的にウインドウをクローズまで持っていきたいです。 ※進みオセェ、、、ハヤク作れよな。

/* * 5.終わりの挨拶 */

ポイントは、 ^^^^^^^^^^^^ 新規のウインドウが開かれる時発生するイベントで、 自分が生成したオブジェクトを代入することです。 http://www.ken3.org/p/2/o20040522.lzh に webdataset2.xlsが圧縮されてます。 処理が中途半端ですが、テストしてみてください。 何か読者の心に残れば、うれしいです。 *私の独り言をうまく消化してくださいね。 三流プログラマー Ken3でした。

No.164 2004/06/12
IE .getElementsByTagNameでタグ指定 .Quitで閉じる
[ページTOPへ戻る]

<IE .getElementsByTagNameでタグ指定 .Quitで閉じる>

どうも、三流プログラマーのKen3です。 今回は、IEでパラメータ入力後に、 新たに開かれた結果ウインドウから情報を抜き出し、 そのウインドウを閉じる、そんなことにチャレンジしてみます。 ※起動したIEから広告コードを抜き取って用済みになった(失礼)IEを閉じる。

/* * 1.やりたいこと 概要 */

楽天ブックのリンク作成ページ http://books.rakuten.co.jp/afvc/afinfo/page03.html ここで、 ISBN番号 と 自分の広告コードのSIDとPIDを入力してボタンを押すと ソースが表示される。 この広告コードを取得、そんなプログラムを作ってみたい。 ポイントになるのが、繰り返しになってしまいますが、 新規のイベントで自分で作ったオブジェクトを代入してます。 '新しいウインドウを開くイベントをチェックする
Private Sub WebBrowser1_NewWindow2(ppDisp As Object, Cancel As Boolean)

    '新しいウインドウを自分の管理下に置きたいので、オブジェクトを代入してあげる
    Set objNEW_IE = CreateObject("InternetExplorer.Application")
    Set ppDisp = objNEW_IE   '作ったオブジェクトを代入

    objNEW_IE.Visible = True '念のため見えるようにする

End Sub
Dim WithEvents objNEW_IE As InternetExplorer とイベントを取れる宣言しているので、 テストで、URLとソースを表示してみました。 '新しく作成したウインドウが読み込まれたら、処理したいので、
Private Sub objNEW_IE_DocumentComplete(ByVal pDisp As Object, URL As Variant)
    MsgBox "あたらしく開かれたURLは" & URL
    MsgBox "HTMLソースは" & objNEW_IE.Document.all(0).innerhtml
End Sub
と、オブジェクトを自分の管理下に置くことができました。 ここから、広告コードを抜き取って、ウインドウを閉じたいと思います。

/* * 2.タグ名指定でオブジェクトをGetする .getElementsByTagName */

オブジェクトが操作可能となったので、広告コードを取り出してみたいと思います。 objNEW_IE.Document.all(0).innerhtml からinstr関数で<TEXTAREA>のタグを探す方法もあるのですが、 今回はカッコつけて、 .getElementsByTagName("タグの名前") を使用してみます。 TEXTAREAのタグなので、 .getElementsByTagName("TEXTAREA") として、取り出してみます。 '新しく作成したウインドウが読み込まれたら、処理したいので、
Private Sub objNEW_IE_DocumentComplete(ByVal pDisp As Object, URL As Variant)
    '読み込み完了を判断する
    If objNEW_IE.ReadyState = READYSTATE_COMPLETE Then '読み込み完了
      'テキストをセットする
      Me.txtKCODE.Value = _
         objNEW_IE.Document.getElementsByTagName("TEXTAREA").Item(0).InnerTEXT
    End If
End Sub
と、こんな感じで、 .getElementsByTagName("TEXTAREA").Item(0).InnerTEXT タグの名前がTEXTAREAでアイテム0番目の内部テキスト を取得できました。

/* * 3.新しく開かれたIEを閉じる .Quitする */

あとは、取得が終わったので、閉じてみます。 閉じるのは.QUITメソッドです。 '新しく作成したウインドウが読み込まれたら、処理したいので、
Private Sub objNEW_IE_DocumentComplete(ByVal pDisp As Object, URL As Variant)
    '読み込み完了を判断する
    If objNEW_IE.ReadyState = READYSTATE_COMPLETE Then '読み込み完了
      'テキストをセットする
      Me.txtKCODE.Value = _
         objNEW_IE.Document.getElementsByTagName("TEXTAREA").Item(0).InnerTEXT
      'IEを閉じる
       objNEW_IE.Quit
    End If
End Sub
ソース取得後、バイバイって感じです。 回線速度が速いと、開いてすぐ閉じてとなると思います。 私の場合は一瞬間があって、見えます。

/* * 4.終わりの挨拶 */

http://www.ken3.org/p/3/o20040529.lzh に webdataset3.xlsが圧縮されてます。 処理が中途半端ですが、テストしてみてください。 webフォームにパラメータをセットして処理実行、 実行時、新しい情報ウインドウが開かれる(新規IEが起動する) そのウインドウから結果データを取得して、閉じる。 そんな流れのテストプログラムでした。 何か読者の心に残れば、うれしいです。 *私の独り言をうまく消化してくださいね。 在宅三流プログラマー Ken3でした。


検索して目的の情報を探す。

目的の情報を探すには、最近はググれとよく聞きます。なので、検索ボックスを付けました。
いろいろなキーワードを入れて、検索してみてください。

カスタム検索
三流君(site:www.ken3.org) 内を Googleを利用してキーワード する

ページフッター

ここまで、読んでいただきどうもです。ここから下は、三流君宛のメッセージ送信や 三流君のホームページの紹介・案内です
目的の情報が見つかったか?少々心配しつつ、、、※質問や感想は、気軽に送ってくださいね。

質問や要望など メッセージを送る(三流君に連絡する)

質問や要望など連絡方法でお互い確認が取りやすく、便利なのが掲示板なのですが、私の対応のまずさから不定期で荒れてしまい、掲示板は現在封鎖中です。(反省しなきゃ)
感想や質問・要望・苦情など 三流君へメッセージを送る。
時間的余裕のある要望・質問・苦情の場合は、下記のフォームからメッセージを送ることができます。
あなたのお名前(ニックネーム):さん
返信は?: 不用(HP更新を待つ) , E-mail→ アドレス:に返事をもらいたい



(感想や質問・要望 メッセージはHPで記事に載せることがあります。)

急ぎで連絡がほしい、そんな時は:[三流君連絡先]に連絡してください。

リンクや広告など

項目別に↓に人気の記事をまとめてみました。お探しのジャンルを選択してください。
人気記事(来場者が多いTOP3):
[VBAでIE,WebBrowserを操作]・・・VBAでIE,WebBrowserを操作する サンプルです
[Access から Excel 連携 CreateObject("Excel.Application")]・・・AccessからExcelを操作したりデータの書き出しなどです
[VBAでOutlookの操作 CreateObject("Outlook.Application" )]・・・VBAからOutlookを使い、メール関係を処理するサンプルです
↑上記3つみたいなCreateObjectで他のアプリケーションを操作するサンプルが人気です。

開発時の操作: [F1を押してHELPを見る]/ [Debug.Print と イミディエイトウインドウ]/ [実行時エラーでデバッグ]/ [ウォッチ式とSTOP]/ [参照設定を行う]

仕様書(設計書?) XXXX書類: [基本設計書や要求仕様書]/ [テスト仕様書 テストデータ]/ [バグ票]/ [関数仕様書]/ [流れは 入力・処理・出力]

Excel関係:
[Excel UserFormを操作する]・・・エクセルでユーザーフォームを作成して入力などを行ってます
[ExcelからAccessを操作する]・・・ExcelからAccessのマクロを起動してみました、
[Excel関係 関数、その他]・・・その他Excel関係です

Access関係:
[Access UserForm/サブフォーム 操作]・・・アクセスでフォームを使ったサンプルです
[Access レポート操作]・・・レポートを操作してみました
[Access クエリーやその他関数]・・・あまりまとまってませんが、スポット的な単体関数の解説です

その他:VBAの共通関数やテキストファイルの操作など
[VBAでテキストファイル(TextFile)の操作]・・・普通のテキストファイルを使ったサンプルです
[VBA 標準関数関係とその他解説]・・・その他、グダグタ解説してます

Blog:[三流君の作業日記]/ [サンプルコードのゴミ箱]/ 広告-[通販人気商品の足跡]



[三流君(TOP ken3.org へ戻る)] / [VBA系TOPへ] / [VBA系バックナンバー目次へ移動]