三流君 ＶＢＡで楽しくプログラミング(Excel/Access VBAの解説/サンプルです)
[VBA系のバックナンバー]
[質問/感想 掲示板]
[メルマガ登録/解除]
[VBA系 TOP]
[サイトマップ]
＜CODE BASE64の変換処理にチャレンジしてみた＞
どうも、三流プログラマーのＫｅｎ３です。
今回は、
BASE64の変換処理にチャレンジしてみます。
http://www.ken3.org/vba/lzh/vba160.lzh
にサンプルbase64test.xlsを圧縮しておきます、
Excel2000版ですが使ってみてください。
/*
* １．今回のキッカケ
*/
前回の
No.159 IE 認証ページへのアクセス、basci認証ページって？
http://www.ken3.org/vba/backno/vba159.html
で、
設定したユーザーとパスワードの組み合わせ
mailmaga:guest
をBASE64変換して
bWFpbG1hZ2E6Z3Vlc3Q=
ヘッダーに指定
"Authorization: Basic bWFpbG1hZ2E6Z3Vlc3Q="
そして開いていました。
今回は、このBASE64のコードを探ってみたいと思います。
/*
* ２．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現在)
う〜ん、ここは用語説明でした、、、
上から３つ目に、
BASE64 について
http://www.sea-bird.org/doc/Cygwin/BASE64enc.html
とサイトがあり、
>1.エンコードすべきデータから、３バイト取得する。
>2.取得した３バイトを２４ビットのデータ領域に設定する。
>3.上位から６ビットを取り出し、その数値を下記の変換テーブルに従い
>キャラクター文字に変換する。
>4.次の６ビット以降も同じ変換を行い、２４ビットすべて変換する。
>5.エンコードすべきデータが無くなるまで、１〜４の作業を繰り返す。
> ※エンコードすべきデータが、２バイトしか無い場合は、それまでBASE64
>エンコード変換した文字列の最終位置に'='を付加する。
> ※エンコードすべきデータが、１バイトしか無い場合は、それまでBASE64
>エンコード変換した文字列の最終位置に'=='を付加する。
>
>変換テーブル：６ビットデータの「０〜６３」を以下の文字列に変換する。
> 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
読んでいくと、
６ビット単位にデータを取り出し、それを指定された文字に当てはめる。
って感じです。
/*
* ３．さっそく作ってみた
*/
手抜きで、漢字２バイトには対応していないが、
下記のように作ってみました。
※なんか無駄に長いんだけど、気にしないでね。
'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バイトを２進数に変換する、２４ビットの数値を作成する
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進数から６ビット単位で4つ取り出し、数値に変換する
For i = 0 To 3
n6BOX(i) = Val("&H0" & STR2toHEX16(Mid(strWORK, 1 + i * 6, 6)))
Debug.Print n6BOX(i)
Next i
'対応表にそって変換する
'６ビットデータの「０〜６３」を以下の文字列に変換する。
' 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
'頭４文字単位かチェックする
n = Len(str2) Mod 4 '足りない文字数を計算する
If n <> 0 Then
str2 = String(4 - n, "0") & str2 '頭に文字０を追加する
End If
strHEX = "" '結果のエリアを初期化する
'文字数分ループする
For n = 1 To Len(str2) Step 4 '４文字(1バイト)単位にループを作る
n8421 = 8 '初期値に８を代入する(上から計算したいので)
nBYTE = 0 '1バイト計算用変数を初期化
For i = 0 To 3 '４回まわるよ(4ビット分)
'ビットが立っているかチェックする
If Mid(str2, n + i, 1) = "1" Then
nBYTE = nBYTE + n8421 'ビットに対応した数値を＋する
End If
'次のビットを計算したいので２で割る
n8421 = n8421 / 2
Next i
'計算して、１倍との数値が完成したので１６進文字にしてセットする
strHEX = strHEX & Hex(nBYTE)
Next n
'リターン値をセットして関数を抜ける
STR2toHEX16 = strHEX
End Function |
'HEX16進文字列を受け取り２進文字列を返す
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 '初期値に８を代入する(上からチェックしたいので)
For i = 1 To 4 '４回まわるよ
If (nCHK And n8421) = 0 Then 'Andでビットをチェックする
str2STR = str2STR & "0" 'ビットは立ってないよ
Else
str2STR = str2STR & "1" 'ビットは立ってるよ
End If
'次のビットをチェックしたいので２で割る
n8421 = n8421 / 2
Next i
Next n
'リターン値をセットして終了
HEX16toSTR2 = str2STR
End Function |
ポイントは、特に無いけど（工夫をしないでダラダラと作ってしまった・・・）
ASP系で使った、
2進数文字列を受け取りHEX16進文字列を返す(頭０を＋する)
http://www.ken3.org/cgi-bin/test/test094-2.asp?DATA=111
と
16進数文字列を２進数文字列へ変換
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
で、３文字単位のループを作り(Step3で3文字飛ばす)
'3バイトを２進数に変換する、２４ビットの数値を作成する
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進数から６ビット単位で4つ取り出し、数値に変換する
For i = 0 To 3
n6BOX(i) = Val("&H0" & STR2toHEX16(Mid(strWORK, 1 + i * 6, 6)))
Debug.Print n6BOX(i)
Next i
ここまでで、６ビット単位の４つの数値が完成する。
で、その数値を、対応表にしたがって、文字に直します。
'対応表にそって変換する
'６ビットデータの「０〜６３」を以下の文字列に変換する。
' 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
と、こんな感じで、３文字単位で変換しました。
※漢字には非対応なので、２バイト文字を使う人は、一工夫してくださいね。
/*
* ４．処理を組み込む
*/
さて、BASE64の変換処理ができたので、前回のソースに組み込んでみます。
Dim strHEAD As String
'ID:passwordをBASE64変換してヘッダ情報を作成する
strHEAD = "Authorization: Basic " & base64("mailmaga:guest") & vbCrLf
として、ヘッダ情報を作ってみました。
※フト、ここにＩＤとパスワード書いたら丸見えですね（オイオイ）
別な問題があると思いつつ、、、
'BASE64でユーザーＩＤ：パスワードを変換して開く
Sub bbbb()
Dim objIE As Object 'ＩＥオブジェクト参照用
'インターネットエクスプローラーのオブジェクトを作る
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 |
/*
* ５．終わりの挨拶
*/
BASE64の変換もどきを作ってみました。
でも、パスワードをVBAに埋め込んでおくとキケンだと感じたり・・・
あっ、逆のデコードも書かなきゃ（と将来のネタを残しつつ）
http://www.ken3.org/vba/lzh/vba160.lzh
にサンプルbase64test.xlsを圧縮しておきます、
Excel2000版ですが使ってみてください。
何か読者の心に残れば、うれしいです。
＊私の独り言をうまく消化してくださいね。
いつも失敗？の負け組のＫｅｎ３でした。
~~~~~~~(↑オイオイ)
＜Outlook VBAでフラグ作成 .FlagStatus .FlagRequest .FlagDueBy＞
どうも、三流プログラマーのＫｅｎ３です。
今回は、
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
上記関連リンクももよろしくね。
/*
* １．今回のキッカケ
*/
掲示板に下記のメッセージを貰いました。
------
> No.55 Outlookを操作してメールを送りたい を参考に、選択したメール本文を
>引用したメールを作成するマクロにチャレンジし、無事、動作することができま
>した。
> しかし、その引用したメール作成処理を行ったかどうかが判らなくなってしまう
>ため、現在は処理を行った元メールに手作業でフラグを付けている状態です。
> その為、フラグを付け忘れてしまうこともあり、この手作業をマクロで組みたい
>のですがご教授お願いいたします。
------
ご教授お願い〜は、基本的に嫌いなフレーズなんだけど、、、
(※なんか掲示板で偉そうにしている人達が好きそうなフレーズなので私は嫌いです)
なんて愚痴系( http://www.ken3.org/guchi/ 参照)みたいなこと言ってないで、
アウトルックのメールのフラグ関係
を
今回は私の攻略法含めて進めてみます。
（本文無駄に長いので拾い読みしてください）
/*
* ２．Outlookのオブジェクトの探り方
*/
これも、私の我流な三流的攻略法だけど、
Outlookのオブジェクトの探り方は、
Outlookを起動します。
^^^^^^^^^^^^^^^^^^^^^
起動後、Alt+F11を押します。
すると、ＶＢＡのいつものよく見かける画面が表示されます。
※ExcelやAccessで参照設定したあとでもＯＫです。
ここで、探りたいオブジェクトの適当な変数を定義します。
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のヘルプを見る。
あれれ・・・ハズシタ（笑）フリダシニ戻る
や
ＯＫ、目的のプロパティ、メソッドだった、となります。
探り方、まとめるとこんな感じで、
該当するオブジェクト型の変数を定義
Dim aa as MailItem
その後、
aa.
と、候補を表示させ、それらしいのにアタック。
aa.FlagStatus と選択後、カーソルを合わせてからF1のヘルプを見る。
そんな流れでいつもVBAのプロパティ、メソッドを探ってます。
※もっと効率の良い、
女の子(オブジェクト)へのアタック方法もあるんだろうけど・・・
あとは、世の中のチャラ男やナンパ男の成功例を見て自分も真似したいので、
GoogleやYahooで探したプロパティ、メソッドをキーワードにして事例を検索します。
すると、
.xxxxx プロパティはひどい女だったよ、
期待させておいてボッタクリのバグかよ・・・
とか
口説き落とすテクや扱い方の注意事項が載ってます。
まぁ、そのまま真似してもいいし、アレンジしてもいいし。
/*
* ３．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) '期限は５日後をセット
'↑ここまです(VBA161で追加)
objMAIL.Display '途中で編集したい時（メール表示してみた)
'おまけでＯｕｔｌｏｏｋ表示
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) '期限は５日後をセット
の３行です。
単に調べたプロパティに値をセットしただけでした。
objMAIL.FlagStatus = 2
と直値で２をセットしてますが、参照設定していれば、
objMAIL.FlagStatus = olFlagMarked
が正しい書き方です。
/*
* ４．終わりの挨拶
*/
今回は、
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関連リンクももよろしくね。
何か読者の心に残れば、うれしいです。
＊私の独り言をうまく消化してくださいね。
はぁ〜、誰か私に女性の攻略方法教えてよと独り言を書きつつ、
人に聞く前に自分で少しは努力したのかよって読者の心の声をすぐに聞きつつ
ヒキコモリの在宅三流プログラマー Ｋｅｎ３でした。
~~~~~~~(↑オイオイ)
＜IE データセット後、JavaScriptを起動する＞
どうも、三流プログラマーのＫｅｎ３です。
今回は、
IE操作で、フォームにデータセット後、
JavaScriptを起動する、そんな処理を行ってみたいと思います。
/*
* １．今回のキッカケ
*/
本を売って、小金を儲けよう、、、そんな不純な心の動きで、
amazon.com と 楽天ブック に 申し込みました。
商品個別リンクがあって、個別の商品リンクを作成できるみたいです。
この、個別リンクの作成にチャレンジしてみたいと思います。
楽天ブックで個別リンクを作るには、
http://books.rakuten.co.jp/afvc/afinfo/page03.html
のページに、
紹介したい本のISBN番号
と
自分の広告コード SIDとPIDを入力して 作成ボタンを押すと、作成されます。
ExcelのVBAから、Webブラウザコントロールを使って、データをセットしてみます。
/*
* ２．動作の仕組みを探る
*/
http://books.rakuten.co.jp/afvc/afinfo/page03.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')処理が走ると、
新規のウインドウに、広告用のソースコードが表示される、
そんな仕組みとなってます。
/*
* ３．仕様を簡単に書く
*/
フォームを作成して、ISBN番号、SID,PIDを入力させます。
SID [ ] ← 設定用のシートからデフォルトを表示する
PID [ ] ← 設定用のシートからデフォルトを表示する
ISBN [ ] ← 目的の番号を入力する
広告 [ ] ← 複数行のテキストボックスを作成して、
・ 広告用のソースを表示させる
・
[ ]
作成ボタン
ボタンが押されたら、
リンク作成ページへ飛び、データをセットして、
リンク作成ボタンを押す(javascriptをVBAから起動)
広告コード用の新規のウインドウが表示される。
そのウインドウから、広告コードを取り出し、
テキストボックスにセットする。
セット完了後、広告作成のweb表示・ブラウザを閉じる。
こんな感じの流れで、
フォームにパラメータセット、
データ送信
サーバー側でコード作成
結果のソースコードを取得
を行ってみたいと思います。
/*
* ４．問題点、技術確認
*/
処理やデータの流れを整理したら、
次は、
予想される問題点を整理します。
技術的に可能か？それとも不可能か？
仕様を聞いて、不安になった部分は？ありますか？
なんて感じで自分に自問自答しながら、項目をまとめていきます。
仕様書からプログラムを起こす前準備で、
・イメージが湧き出してすぐにでも作れそうと感じるか、
・それとも、不安になるか、、、
ここのファーストタッチが重要だと思います。
※性格的にいつも不安な担当者 や 根拠の無い自信がある担当者も居るんだけど。
今回の処理を私なりにまとめたポイントは、
webのコントロールにデータをセット可能か？
→ 過去やったことがある(経験がある自信あるし、ここは大丈夫と答えられる)
webのjavascriptをVBAから起動できるのか？
→ 過去、ボタンのコントロールに対して、
.Clickメソッドでやったことあるが
指定した関数をパラメータ付きで起動したことは無い
※技術的にできることを早急に確認する
webのコントロールから作られたウインドウのデータを取得できるか？
→ javascriptでopenされた結果の表示(新規ウインドウ)
からデータを取得可能か and 取得方法を調べる
など、仕様書(やりたいこと) から 予想される問題点を洗い出します。
あとは、その問題点をまず、簡単なテストでつぶします。
つぶしきれなかったら、仕様を変えてもらうなどの処理が必要です。
よくある話ですが、
夢のような仕様なのか、現実的な仕様なのか作成に入る前に判断します。
不安を先送りにすると、ロクナコト無いですよ。
また、よく掲示板で目にする話なのですが、
ＸＸＸＸはできるのでしょうか？事前調査で知りたい
って書き込みかなぁ。これもアリでしょう。
※実際の問題点やソースを開示しろと言われてる場面も見かけるが。
チョット内容が違うけど、愚痴系のメルマガで、
No.138 アイツが打てたから、オレも打てる。マシンガン打線
http://www.ken3.org/guchi/backno/guchi138.html
なんて書いてます、
実現可能な仕様 や 過去に経験者が居ると安心だよね。
/*
* ５．IE データセット後、JavaScriptを起動する
*/
楽天ブックのリンク作成ページ
http://books.rakuten.co.jp/afvc/afinfo/page03.html
ここで、
ＩＳＢＮ番号 と 自分の広告コードの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しないと。
/*
* ６．終わりの挨拶
*/
http://www.ken3.org/p/o20040515.lzh
に
webdataset.xlsが圧縮されてます。
処理が中途半端ですが、テストしてみてください。
何か読者の心に残れば、うれしいです。
＊私の独り言をうまく消化してくださいね。
ヒキコモリの在宅三流プログラマー Ｋｅｎ３でした。
~~~~~~~(↑オイオイ)
＜IE _NewWindow2 別窓で開いたオブジェクトの管理＞
どうも、三流プログラマーのＫｅｎ３です。
今回は、
リンクを右ボタンで新しいウインドウで開く
や
Target=_Blank
など
親ウインドウから子供のウインドウが開かれた時の管理について少し書きます。
ＩＥ操作で、何かの参考となれば、幸いです。
/*
* １．今回のキッカケ
*/
右ボタンなどを押して、新しいウインドウをユーザーの意思で開くことができます。
まぁ、マルチにウインドウを開いて処理を行う、普通のことなのですが、
Webコントロールをフォームに貼ったりして作業していると、
自分(自作プログラム)の配下から離れてしまいます。
そんなことをさせなかったり、
されても、作られたオブジェクトを追ってみたいと思います。
WebBrowser1
とWebのコントロールを作ります。
WebBrowser1_NewWindow2で、新しいウインドウが開かれた時のイベントを受取れます。
これを使用してみます。
/*
* ２．新しいウインドウが開く時に発生するイベント_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 |
/*
* ３．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
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
End Sub |
/*
* ４．応用して、新規ウインドウのソースを表示してみた
*/
開かれたウインドウ(新規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
とイベントを取れるオブジェクト型のグローバル変数を１つ作成します。
次に、フォームに貼った、
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 と 新しく開くウインドウにも指定します。
すると、新しく開かれたＩＥ=自分の管理化のobjNEW_IE変数となります。
あとは、
Dim WithEvents objNEW_IE As InternetExplorer
とイベントを取れる宣言しているので、
テストで、URLとソースを表示してみました。
'新しく作成したウインドウが読み込まれたら、処理したいので、
Private Sub objNEW_IE_DocumentComplete(ByVal pDisp As Object, URL As Variant)
MsgBox "あたらしく開かれたＵＲＬは" & URL
MsgBox "HTMLソースは" & objNEW_IE.Document.all(0).innerhtml
End Sub |
こんな感じで、JavaScriptで新しく開かれたIEのソースを取得できそうです。
なんて書いてますが、
実行してみるとわかりますが、
objNEW_IE_DocumentComplete
のイベントが２回走ってます。
ここも細工して、広告コードを取得したら、
自動的にウインドウをクローズまで持っていきたいです。
※進みオセェ、、、ハヤク作れよな。
/*
* ５．終わりの挨拶
*/
ポイントは、
^^^^^^^^^^^^
新規のウインドウが開かれる時発生するイベントで、
自分が生成したオブジェクトを代入することです。
http://www.ken3.org/p/2/o20040522.lzh
に
webdataset2.xlsが圧縮されてます。
処理が中途半端ですが、テストしてみてください。
何か読者の心に残れば、うれしいです。
＊私の独り言をうまく消化してくださいね。
三流プログラマー Ｋｅｎ３でした。
＜IE .getElementsByTagNameでタグ指定 .Quitで閉じる＞
どうも、三流プログラマーのＫｅｎ３です。
今回は、ＩＥでパラメータ入力後に、
新たに開かれた結果ウインドウから情報を抜き出し、
そのウインドウを閉じる、そんなことにチャレンジしてみます。
※起動したＩＥから広告コードを抜き取って用済みになった（失礼）IEを閉じる。
/*
* １．やりたいこと 概要
*/
楽天ブックのリンク作成ページ
http://books.rakuten.co.jp/afvc/afinfo/page03.html
ここで、
ＩＳＢＮ番号 と 自分の広告コードの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
MsgBox "HTMLソースは" & objNEW_IE.Document.all(0).innerhtml
End Sub |
と、オブジェクトを自分の管理下に置くことができました。
ここから、広告コードを抜き取って、ウインドウを閉じたいと思います。
/*
* ２．タグ名指定でオブジェクトを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でアイテム０番目の内部テキスト
を取得できました。
/*
* ３．新しく開かれた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 |
ソース取得後、バイバイって感じです。
回線速度が速いと、開いてすぐ閉じてとなると思います。
私の場合は一瞬間があって、見えます。
/*
* ４．終わりの挨拶
*/
http://www.ken3.org/p/3/o20040529.lzh
に
webdataset3.xlsが圧縮されてます。
処理が中途半端ですが、テストしてみてください。
webフォームにパラメータをセットして処理実行、
実行時、新しい情報ウインドウが開かれる（新規IEが起動する）
そのウインドウから結果データを取得して、閉じる。
そんな流れのテストプログラムでした。
何か読者の心に残れば、うれしいです。
＊私の独り言をうまく消化してくださいね。
在宅三流プログラマー Ｋｅｎ３でした。
ページフッター(リンクや広告など)
[三流君(TOP ken3.org へ戻る)]
-- [VBA系TOPへ]
---- [VBA系バックナンバー目次へ移動]
------ [VBAでIEを操作 CreateObject("InternetExplorer.application")]・・・実は当店一番人気、VBAでIEを操作するサンプルです
------ [VBAでOutlookの操作 CreateObject("Outlook.Application")]・・・Outlookを使い、メール関係の処理です
------ [Access から Excel 連携 CreateObject("Excel.Application")]・・・人気のAccessからExcelへデータ書き出しなどです
------ [AccessのUserForm/サブフォームを操作]・・・アクセスでフォームを使ったサンプルです
------ [Accessのレポートを操作]・・・レポートを操作してみました
------ [Access クエリー関係やその他関数]・・・あまりまとまってませんが、スポット的な単体関数の解説です
------ [Excel UserForm(ユーザーフォーム)を操作する]・・・エクセルでユーザーフォームを作成して入力などを行ってます
------ [ExcelからAccessを操作する]・・・ExcelからAccessのマクロを起動してみました、
------ [Excel関係 関数、その他]・・・その他Excel関係です
------ [VBAでテキストファイル(*.txt,*.html,*.csv)の操作]・・・テキストファイルを使ったサンプルです
------ [VBA 標準関数関係とその他解説]・・・その他、グダグタ解説してます
広告
-- [通販系の売れ筋広告へ] ←主に楽天やAmazonのランキングです
blog
-- [三流君の作業日記] ← 日々の作業を少々
-- [通販あしあと] ← 通販ページの足跡を一覧で羅列
情報を探す
情報を探すならGoogleかな？
↓Web全体、サポート情報(support.microsoft.com)や三流君VBA(ken3.org)から検索する
書籍の購入
Webだけじゃさすがに勉強しきれないので、プログラミング関係の書籍も読んでみては？？
コンピュータ書籍の発送がハヤイ専門店
 コンピュータの本・専門店
|
※種類が豊富で探し易いです。※在庫ありが48時間以内発送が急ぎで資料や書籍がほしい時、とても助かります。
お奨め本の目次を見るだけでも勉強になったり
|
amazon.co.jpでキーワード別チェック
下記、私が設定したキーワードですが、こんな感じで資料や書籍を探ってみては？
[VBA全体を把握する] -- やはり全体をさらっと見たいですよね。
[SQL関連でＤＢ力UP] -- システムはデータベース設計が重要
[ADO接続を探る] -- VBAなのでADO接続を押さえておく
[Windows APIを探る] -- さらにAPIになて知ってれば強力だ！
[.NETを探る] -- と言っても時代は.NETに流れてるし
プログラミング以外でも知りたいことは多くって、
[人間関係] -- で、客先・上司、まわりに気を使い。
[プログラマーの自己啓発] -- プログラムだけじゃなくいろいろと向上したいよ
[コーチング・育成] -- 先輩になったら後輩(部下)の面倒をみてね。
そんなこんなでプログラマーっていろいろと大変なんだってば・・・