end0tknr's kipple - 新web写経開発

http://d.hatena.ne.jp/end0tknr/ から移転します

excel vbaからIEを操作。DOMの探索( getelementsbyname() , getElementsByTagName() )もOK

VBAによるIE自動制御
↑こちらを参考にしながら、↓こう書いてみました。

Sub main()
    Call GetSysData(Range("C5"))
End Sub

'***************************************************************************
Sub GetSysData(Target)
    Dim URL As String, o As Variant
    Dim IE As Object

    Set IE = CreateObject("InternetExplorer.Application")
    URL = "http://test.example.com/entry.cgi"
    
    With IE
    .navigate (URL)
    '.Visible = True
    Call Wait(IE)
    On Error Resume Next
    
    .Document.getelementsbyname("credential_0")(o).Value = Range("C7")
    .Document.getelementsbyname("credential_1")(o).Value = Range("C8")
    .Document.all("Submit").Click
    On Error GoTo 0
 
    Call Wait(IE)
    
        .Document.getelementsbyname("cus_code")(o).Value = Target.Value
        .Document.all("search").Clicku
    Call Wait(IE)
    On Error GoTo Errrhdl
    
    'HTMLの表から値を取得
    URL = "邸名  : " & .Document.getElementsByTagName("table").Item(1).Rows(5).Cells(5).innertext & vbNewLine
    URL = URL & "出荷日 : " & .Document.getElementsByTagName("table").Item(1).Rows(5).Cells(10).innertext
    MsgBox URL
   'csvダウンロードのアドレスを格納
    URL = .Document.getElementsByTagName("a").Item(12)
    .navigate (URL)
    'Application.Wait (Now + TimeValue("0:00:5"))
    'Workbooks.Open ("C:\TMP\SYSからデータ取得.xls")
    On Error GoTo 0

    End With
    Set IE = Nothing
   'Application.Quit
    Exit Sub

Errrhdl:
    MsgBox "条件に該当するデータが見つかりません。"
    URL = "http://test.example.com/entry.cgi"
    With IE
        .navigate (URL)
        .Visible = True
    End With
    Set IE = Nothing
    'cancel = True
End Sub

Sub Wait(ByRef IE As Variant)
    Do While IE.busy = True
        DoEvents
    Loop
    Application.Wait (Now + TimeValue("0:00:01"))
End Sub