まぁ、ソースと実行結果を見てもらったほうがハヤイかなぁ。
下記、ソースと実行結果です。
'参照設定 Microsoft Internet Controls(Microsoft Browser Helpers)
'Microsoft HTML Object Library の ２つを忘れずに
'参照設定の方法は、 http://www.ken3.org/cgi-bin/group/vba_ie_object.asp をみてください。
Sub URLを取得する()
'B3に格納されている、目的のURLを表示して、リンク情報を書き出す。
Dim objIE As InternetExplorer
Dim strURL As String
Dim i As Integer
Dim nYLINE As Integer
'データエリアを削除する。
Rows("10:9999").Delete Shift:=xlUp
'IEのオブジェクトを作成する
Set objIE = CreateObject("InternetExplorer.application")
objIE.Visible = True
'ページを開く(.Navigateで表示する。)
strURL = Range("B3") 'URL代入
objIE.Navigate "" & strURL 'アドレスを渡し表示する
'読み込み完了となるまで、ループする。
While objIE.ReadyState <> READYSTATE_COMPLETE Or objIE.Busy
DoEvents
Wend
Debug.Print objIE.Document.Title
Debug.Print objIE.Document.URL
'リンクを探す
'リンク数分まわす A列にアンカーテキスト B列にURLを書く
nYLINE = 10 '10行目からせっとするので
For i = 0 To objIE.Document.Links.Length - 1
Cells(nYLINE, "A") = "'" & objIE.Document.Links(i).innerText 'テキスト
Cells(nYLINE, "B") = "'" & objIE.Document.Links(i).href 'URL
nYLINE = nYLINE + 1 'セット位置を＋1する
Next i
objIE.Quit 'ＩＥを閉じる
End Sub
データの流れ、データ遷移図、イメージ図
↑なんか、よけい、わからないか・・・
下記のソースと実行結果を見てください。
'参照設定 Microsoft Internet Controls(Microsoft Browser Helpers)
'Microsoft HTML Object Library の ２つを忘れずに
'参照設定の方法は、 http://www.ken3.org/cgi-bin/group/vba_ie_object.asp をみてください。
Sub DB_UPDATE() 'MDBへソースを登録する。
'B列のURLを開き、ソースを取得して(TDとPREのタグを見て)
'MDBファイルへ書き込む。
'IEのオブジェクトを作成する
Dim objIE As InternetExplorer
Set objIE = CreateObject("InternetExplorer.application")
objIE.Visible = True
objIE.GoHome
Dim strTITLE As String
Dim DB As DAO.Database 'DAOです。
Dim TB As DAO.Recordset 'DAOです。
Dim nCNT As Integer
Dim strSQL As String
Dim objTD As Object
Dim n As Integer
Dim x As Integer
Dim strHTML As String
Dim strTEXT As String
'DBを開く ここでは、DAOを使用しました。
Set DB = OpenDatabase(ThisWorkbook.Path & "\VBACODE.mdb")
For nYLINE = 10 To 9999 '10行目からループ。
strTITLE = Left(Trim(Cells(nYLINE, "A")), 80)
If Len(strTITLE) = 0 Then Exit For 'A列のタイトルが無くなったら抜ける。
DoEvents
'SQLを作成する
strSQL = "Select * From T_CODE Where [タイトル]='" & Replace(strTITLE, "'", "''") & "'"
Set TB = DB.OpenRecordset(strSQL)
nCNT = TB.RecordCount
If nCNT = 0 Then 'データ無し 0の時 URLを表示してチェックする追加する
'URLを表示する
objIE.Navigate Cells(nYLINE, "B")
While objIE.ReadyState <> READYSTATE_COMPLETE Or objIE.Busy
DoEvents
Wend
'手抜きで待つ(オブジェクトの展開時間を待つ)動画を見やすくするため。普通はいらない
Application.Wait Time:=Now + TimeValue("00:00:03") '3秒間 ボーっとする
'DBに書き込む
TB.AddNew
'IEページデータを取り込む
TB![Title] = objIE.Document.Title '読み込んだページのタイトルをセットする。
Set objTD = objIE.Document.all.tags("TD") 'TDのタグを抜く。(集める)
strHTML = "" '初期化する
x = 0 'ソースコードのカウンター(html内に複数のソースコードがあるので、)
For n = 0 To objTD.Length - 1 '集めたTDタグを全て見たいので頭からまわす。
If Left(objTD(n).innerHTML, 5) = "<PRE>" Then 'TDの内側が PREで始まっているか？
x = x + 1
strHTML = strHTML & "<h3>'" & Format(x, "000") & "番目のソースコード</h3><HR>" & vbCrLf
strHTML = strHTML & objTD(n).innerHTML & "<HR>" & vbCrLf
strTEXT = strTEXT & Format(x, "000") & "番目のソースコード" & vbCrLf
strTEXT = strTEXT & vbCrLf & objTD(n).innerText & vbCrLf & vbCrLf
End If
Next n
If strHTML = "" Then
strHTML = "ソースがみつからない"
strTEXT = "ソースがみつからない"
End If
TB![HTMLCODE] = strHTML 'データのセット HTMLテキストをメモ型へ
TB![TEXTCODE] = strTEXT
TB![URL] = Trim(Cells(nYLINE, "B"))
TB![タイトル] = strTITLE
TB![区分] = Range("H3")
TB.Update '忘れずに更新する。
Cells(nYLINE, "E") = "追加したよ"
Cells(nYLINE, "E").Select
Else
'
Cells(nYLINE, "F") = "既にDBに存在したよ"
End If
TB.Close
'手抜きで待つ 動画撮影用、普通は要らないよ。。。
Application.Wait Time:=Now + TimeValue("00:00:03") '3秒間 ボーっとする
Next
'後始末
DB.Close
Cells(10, "A").Select
objIE.Quit 'ＩＥを閉じる
End Sub
５．保存ボタンを押す
Submitのボタンが、確認と保存の2つあるので、Forms(番号 or "名前・ID").Submit が効かないので、
保存のボタンを探し、.Clickで押してみました。
Set objINPUT = objIE.Document.all.tags("INPUT") 'INPUTのタグを抜く、allから集める
For n = 0 To objINPUT.length - 1 '抜いた数ループする。
If objINPUT(n).Value = "保存" Then '保存のボタンを Valueで判断する。
objINPUT(n).Click '見つけたので、クリックする
こんな感じで、INPUTのタグから、保存の値を探し、押してみました。
