Sub shell_ie()
Dim strURL As String 'URL保存用
strURL = """" & Range("c8").Text & """" 'URLをC8から取得する
Call Shell("explorer.exe " & strURL, vbNormalFocus)
End Sub
Sub Web_Get_Table_test0317()
'IE起動
Dim objIE As Object 'ＩＥオブジェクト参照用
Set objIE = CreateObject("InternetExplorer.application") 'IEのオブジェクトを作る
objIE.Visible = True '見えるようにする(お約束)
'C8のURLを表示する
'.Navigate で 指定した文字列のURLを開く
objIE.Navigate Range("c8").Text
'表示終了まで待つ .Busy(忙しい)間 と.ReadyState(ステータス)が４以外の時 ループ
Do While objIE.Busy = True
DoEvents '特に何もしないで.Busyの状態が変わるまで待つ
Loop
Do While objIE.ReadyState <> 4
DoEvents '特に何もしないで.ReadyStateの状態が４に変わるまで待つ
Loop
'テーブルを探す
'1 行目のデータを取り出す｡
' TH TD の 項目とC10の条件を比較して目的の表か判断。
' 目的の表を見つけたらシートに書き出す｡
'※テーブルが見つからない時は､エラーメッセージを表示
End Sub
03/17 VBA IE 表を取り込む 過去のコードをコピー使用
http://www.youtube.com/watch?v=6rg0OMKOHqk
※↑これをやるから、過去の潜在的なバグも一緒に未来のシステムへ移植される・・・
次は、やっと、テーブルの取出しです。
タグの取出しが、.tags("タグの名前")でできるので、
Dim objTABLE As Object 'TABLEの格納用
Set objTABLE = objIE.document.all.tags("TABLE") '.tags("TABLE")でTABLEタグを抜く
↑テーブルを取り出す。↓で作りました。
'テーブルを探す
'タグの取出しが、.tags("タグの名前")でできるので、
Dim objTABLE As Object 'TABLEの格納用
Set objTABLE = objIE.document.all.tags("TABLE") '.tags("TABLE")でTABLEタグを抜く
'↑テーブルを取り出す｡
'テーブルの有無を確認
If objTABLE.Length = 0 Then
'メッセージ表示
MsgBox "テーブルがありません"
'IE を 閉じるか確認
If MsgBox("IEを閉じますか？", vbYesNo) = vbYes Then
objIE.Quit '.Quitで閉じる
End If
Exit Sub
End If
03/17 VBA IE 表を取り込む テーブルの取出し
http://www.youtube.com/watch?v=MFIOLfbldbA
次は、
'1行目のデータを取り出す｡
' TH TD の 項目とC10の条件を比較して目的の表か判断。
です。
事前調査で探って、使えそうなのが、
? objTABLE(2).rows(1).cells(1).innertext
なので、これを使ってループでまわして、みたいと思います。
'1行目のデータを取り出す｡
' objTABLE(n).rows(0).cells(x).innertext
Dim n As Integer 'n番目の表
Dim x As Integer '列の管理
For n = 0 To objTABLE.Length - 1 'テーブルの数ループする。
Debug.Print "n = " & n
Debug.Print "列数は .Rows(0).Cells.Length = " & objTABLE(n).Rows(0).Cells.Length
For x = 0 To objTABLE(n).Rows(0).Cells.Length - 1 '列数分ループ
Debug.Print objTABLE(n).Rows(0).Cells(x).innertext '中身をテスト表示
Next
Next
配列が０から始まっているので、
.Rows(0) が １行目です。
あとは、１行目 の x列.テキスト って感じで、
Debug.Print objTABLE(n).Rows(0).Cells(x).innertext
でテストしました。
03/17 VBA IE 表を取り込む １行目のデータをテスト表示
http://www.youtube.com/watch?v=gOXxwJgsCis
あとは、テーブルの値と条件(C10)を比べて、取り込む表を確定させます。
objTABLE(n).Rows(0).Cells(x).innertext
と
Range("c10") を 素直にIf文で比べます。
ひとつ、見つけた時の判断と、後の書き出しで使いたいので、
Dim nTARGET As Integer '見つけた表の番号
↑の変数を１つ作ります。
nTARGET = -1 '初期値を見つからなかった-１とする
For n = 0 To objTABLE.Length - 1 'テーブルの数ループする。
Debug.Print "n = " & n
Debug.Print "列数は .Rows(0).Cells.Length = " & objTABLE(n).Rows(0).Cells.Length
For x = 0 To objTABLE(n).Rows(0).Cells.Length - 1 '列数分ループ
Debug.Print objTABLE(n).Rows(0).Cells(x).innertext '中身をテスト表示
'Cells(x) と C10の条件を比較して目的の表か判断。
If objTABLE(n).Rows(0).Cells(x).innertext = Trim(Range("c10").Text) Then
nTARGET = n '表の番号をセット保存。
Exit For
End If
Next
If nTARGET <> -1 Then Exit For '見つけられたら抜けるよ。
Next
If nTARGET = -1 Then '見つからなかったか？
'※テーブルが見つからない時は､エラーメッセージを表示
MsgBox "見つかりません"
Else '見つかった時
'目的の表を見つけたらシートに書き出す｡
Stop
End If
↑単純に、If objTABLE(n).Rows(0).Cells(x).innertext = Trim(Range("c10").Text) で判断して、
nTARGET = n
で、見つけた表の番号をセット保存。
して、Exit For で ループを抜けました。
※表を見つけたので、やっと書き出せるかなぁ。。。
03/17 VBA IE 表を取り込む セルC10と一致する表を探す
http://www.youtube.com/watch?v=DODydCiDMgg
やっと、表の書き出し処理です。
nTARGET に 書き出す表の番号が保存されているので、
objTABLE(nTARGET).Rows(y).Cells(x).innertext
↑こんな感じで、値を取り出しセットしてみたいと思います。
'目的の表を見つけたらシートに書き出す｡
Sheets("TABLE").Select 'シートを切り替える
Cells.Select
Selection.Delete Shift:=xlUp
Range("B2").Select
For y = 0 To objTABLE(nTARGET).Rows.Length - 1 '行のループ
For x = 0 To objTABLE(nTARGET).Rows(y).Cells.Length - 1 '列数分ループ
Cells(y + 1, x + 1) = objTABLE(nTARGET).Rows(y).Cells(x).innertext
Next
Next
↑単純に y,x の ループを作り、データを
Cells(y + 1, x + 1) = objTABLE(nTARGET).Rows(y).Cells(x).innertext
でセットしました。
y+1,x+1 は、Excelセルの番地は１から始まっているので、調整でセットしました。
03/17 VBA IE 表を取り込む Webの表をシートに書き出す
http://www.youtube.com/watch?v=cxdPQGNCA1c
Sub Web_Get_Table_test0317()
'IE起動
Dim objIE As Object 'ＩＥオブジェクト参照用
Set objIE = CreateObject("InternetExplorer.application") 'IEのオブジェクトを作る
objIE.Visible = True '見えるようにする(お約束)
'C8のURLを表示する
'.Navigate で 指定した文字列のURLを開く
objIE.Navigate Range("c8").Text
'表示終了まで待つ .Busy(忙しい)間 と.ReadyState(ステータス)が４以外の時 ループ
Do While objIE.Busy = True
DoEvents '特に何もしないで.Busyの状態が変わるまで待つ
Loop
Do While objIE.ReadyState <> 4
DoEvents '特に何もしないで.ReadyStateの状態が４に変わるまで待つ
Loop
'テーブルを探す
'タグの取出しが、.tags("タグの名前")でできるので、
Dim objTABLE As Object 'TABLEの格納用
Set objTABLE = objIE.document.all.tags("TABLE") '.tags("TABLE")でTABLEタグを抜く
'↑テーブルを取り出す｡
'1行目のデータを取り出す｡
' objTABLE(n).rows(0).cells(x).innertext
Dim n As Integer 'n番目の表
Dim x As Integer '列の管理
Dim y As Integer '行の管理
Dim nTARGET As Integer '見つけた表の番号
nTARGET = -1 '初期値を見つからなかった-１とする
For n = 0 To objTABLE.Length - 1 'テーブルの数ループする。
Debug.Print "n = " & n
Debug.Print "列数は .Rows(0).Cells.Length = " & objTABLE(n).Rows(0).Cells.Length
For x = 0 To objTABLE(n).Rows(0).Cells.Length - 1 '列数分ループ
Debug.Print objTABLE(n).Rows(0).Cells(x).innertext '中身をテスト表示
'Cells(x) と C10の条件を比較して目的の表か判断。
If objTABLE(n).Rows(0).Cells(x).innertext = Trim(Range("c10").Text) Then
nTARGET = n '表の番号をセット保存。
Exit For
End If
Next
If nTARGET <> -1 Then Exit For '見つけられたら抜けるよ。
Next
If nTARGET = -1 Then '見つからなかったか？
'※テーブルが見つからない時は､エラーメッセージを表示
'メッセージ表示
'IE を 閉じるか確認
If MsgBox("テーブルが見つかりません" & vbCrLf & "IEを閉じますか？", _
vbYesNo) = vbNo Then
Exit Sub '何もせず関数を抜ける。IEを閉じない
End If
Else '見つかった時
'目的の表を見つけたらシートに書き出す｡
Sheets("TABLE").Select 'シートを切り替える
Cells.Select
Selection.Delete Shift:=xlUp
Range("B2").Select
'Webの表をシートへ転記(代入する)
For y = 0 To objTABLE(nTARGET).Rows.Length - 1 '行のループ
For x = 0 To objTABLE(nTARGET).Rows(y).Cells.Length - 1 '列数分ループ
Cells(y + 1, x + 1) = objTABLE(nTARGET).Rows(y).Cells(x).innertext
Next
Next
End If
'終了処理
objIE.Quit 'IEを閉じる
Set objIE = Nothing '変数の後始末
End Sub
'C8のURLを表示
'C10の条件でテーブルを探す
'見つかったテーブルを シート名:TABLE に書き込む
'Vista で 動かすために、初期表示 と objIEの作り方を変更 2009/03/18
Sub Web_Get_Table_test0318_Vista()
Dim objSHELL As Object 'Shell.Application
Dim objWINDOW As Object '.Windows
Dim Wait_Time As Date '時間待ちで使う
Dim objIE As Object 'IEオブジェクトを格納する
'IEをShell関数とexplorer.exeを使い 指定したURLをIEで起動
Call Shell("explorer.exe """ & Range("c8").Text & """", vbNormalFocus) 'セルC8の値でIEを起動する
'↑C8のURLを表示する ↑
'.Navigate で 指定した文字列のURLを開く
'objIE.Navigate Range("c8").Text '通常は..Navigateだけど、今回は、Shellで起動。。。
'↑の起動待ち↓なんか、止まった感じがしてイヤなんだけど。。。
Wait_Time = DateAdd("s", 6, Now()) '6秒後を DateAddで計算
Do While Now() < Wait_Time '現在時刻が↑より小さい間 バカみたいに空回り(時間待ち)
DoEvents
Loop
'↑ホントはShell関数とexplorer.exeでIEが完全に起動するまで待ちたいんだけどなぁ・・・
'※三流コードサンプルからアレンジして 良いコードを作ってくださいね。
'シェルのオブジェクトを作成する
Set objSHELL = CreateObject("Shell.Application")
'起動した IE が 必ず 絶対 一番後ろ と決め付けて(プログラマーに絶対は無いだろクソ三流)
Set objIE = objSHELL.Windows(objSHELL.Windows.Count - 1)
'↑配列が０からなのでカウント-１ 一番後ろのWindowをobjIEに代入
Set objSHELL = Nothing 'この変数は 三流君みたいにもう用済みなので、バイバイ
'ココから下は、いつもどおり、IEを使用する。
'表示終了まで待つ .Busy(忙しい)間 と.ReadyState(ステータス)が４以外の時 ループ
Do While objIE.Busy = True
DoEvents '特に何もしないで.Busyの状態が変わるまで待つ
Loop
Do While objIE.ReadyState <> 4
DoEvents '特に何もしないで.ReadyStateの状態が４に変わるまで待つ
Loop
'テーブルを探す
'タグの取出しが、.tags("タグの名前")でできるので、
Dim objTABLE As Object 'TABLEの格納用
Set objTABLE = objIE.Document.all.tags("TABLE") '.tags("TABLE")でTABLEタグを抜く
'↑テーブルを取り出す｡
'1行目のデータを取り出す｡
' objTABLE(n).rows(0).cells(x).innertext
Dim n As Integer 'n番目の表
Dim x As Integer '列の管理
Dim y As Integer '行の管理
Dim nTARGET As Integer '見つけた表の番号
Dim strMOJI As String
nTARGET = -1 '初期値を見つからなかった-１とする
For n = 0 To objTABLE.Length - 1 'テーブルの数ループする。
Debug.Print "n = " & n
Debug.Print "列数は .Rows(0).Cells.Length = " & objTABLE(n).Rows(0).Cells.Length
For x = 0 To objTABLE(n).Rows(0).Cells.Length - 1 '列数分ループ
Debug.Print objTABLE(n).Rows(0).Cells(x).innertext '中身をテスト表示
'Cells(x) と C10の条件を比較して目的の表か判断。
strMOJI = objTABLE(n).Rows(0).Cells(x).innertext '値を代入
strMOJI = Replace(strMOJI, vbCr, "") '改行コードを消す 0x0d 0x0a
strMOJI = Replace(strMOJI, vbLf, "")
If strMOJI = Trim(Range("c10").Text) Then
nTARGET = n '表の番号をセット保存。
Exit For
End If
Next
If nTARGET <> -1 Then Exit For '見つけられたら抜けるよ。
Next
If nTARGET = -1 Then '見つからなかったか？
'※テーブルが見つからない時は､エラーメッセージを表示
'メッセージ表示
'IE を 閉じるか確認
If MsgBox("テーブルが見つかりません" & vbCrLf & "IEを閉じますか？", _
vbYesNo) = vbNo Then
Exit Sub '何もせず関数を抜ける。IEを閉じない
End If
Else '見つかった時
'目的の表を見つけたらシートに書き出す｡
Sheets("TABLE").Select 'シートを切り替える
Cells.Select
Selection.Delete Shift:=xlUp
Range("B2").Select
'Webの表をシートへ転記(代入する)
For y = 0 To objTABLE(nTARGET).Rows.Length - 1 '行のループ
For x = 0 To objTABLE(nTARGET).Rows(y).Cells.Length - 1 '列数分ループ
Cells(y + 1, x + 1) = objTABLE(nTARGET).Rows(y).Cells(x).innertext
Next
Next
End If
'終了処理
objIE.Quit 'IEを閉じる
Set objIE = Nothing '変数の後始末
End Sub
03/16 VBA IE 表の取り込み 詳細設計書 テスト仕様書
http://www.youtube.com/watch?v=vNP1XZmdhBQ