2017-10-10 18 views
0

私は少し問題に遭遇しています。通常、私はテーブルを引っ張るときにExcelの "data from web"ツールを使用しますが、ユーザー名とパスワードの入力が必要なデータを取得する必要があります。私はそれのためのいくつかのコードを(おそらく最もエレガントではないが)考え出したが、一度私が望むページに着くと、テーブルを抽出する方法がわからない。ここまで私がこれまで持っていたことがあります。ログインが行われた後現在のWebサイトでWebテーブルを照会してください

Sub Login() 
    Sheets("IOL").Select 
    Set ie = CreateObject("InternetExplorer.application") 
    ie.Visible = True 
    ie.Navigate ("https://internalsite.company.com/secure/login" & ActiveCell) 
    Do 
     If ie.ReadyState = 4 Then 
      ie.Visible = True 
      Exit Do 
     Else 
      DoEvents 
     End If 
    Loop 
    ie.Document.forms(0).all("badgeBarcodeId").Value = "00000" 
    ie.Document.forms(0).submit 
'used because it redirects to a new page after submitting and I couldn't figure out how to make it wait for the new page to load before proceeding. 
    Application.Wait (Now + TimeValue("0:00:02")) 
    ie.Document.forms(0).all("password").Value = "00000" 
    ie.Document.forms(0).submit 
End Sub 

私はhttp://internalsite.company.com/csvに移動し、シートに直接CSVファイルをインポートしたいと思います。新しい接続を行うたびに、再度ログインするので、新しい接続を追加せずにファイルを抽出する方法がなければならないと思います。私はもっ​​と複雑なVBAでかなり新しいので、私に同行してください。

答えて

1

私はこのコードで仕事をすることができましたが、テーブルの代わりに直接CSVを取得する方がより望ましいです。テーブルが読み込まれたくない場合があります。

Sub Login() 
     Dim clip As DataObject 
     Dim ieTable As Object 
     Set ie = CreateObject("InternetExplorer.application") 
     ie.Visible = True 
     ie.Navigate ("https://internalsite1.company.com/secure/login" & ActiveCell) 
     Do 
      If ie.ReadyState = 4 Then 
       ie.Visible = True 
       Exit Do 
      Else 
       DoEvents 
      End If 
     Loop 
     ie.Document.forms(0).all("badgeBarcodeId").Value = "00000" 
     ie.Document.forms(0).submit 
     Do While ie.Busy: DoEvents: Loop 
     Do Until ie.ReadyState = 4: DoEvents: Loop 
     ie.Document.forms(0).all("password").Value = "000000" 
     ie.Document.forms(0).submit 
     Do While ie.Busy: DoEvents: Loop 
     Do Until ie.ReadyState = 4: DoEvents: Loop 
     ie.Navigate "http://internalsite2.company.com/site/Inbound?filter=1To3Days" 
     Do While ie.Busy: DoEvents: Loop 
     Do Until ie.ReadyState = 4: DoEvents: Loop 
     Set ieTable = ie.Document.all.Item("DataTables_Table_0") 
     If Not ieTable Is Nothing Then 
     Set clip = New DataObject 
     clip.SetText "" & ieTable.outerHTML & "" 
     clip.PutInClipboard 
     Workbooks("Production Meeting Dashboard.xlsm").Activate 
     Sheets("IOL").Select 
     Range("A1").Select 
     ActiveSheet.PasteSpecial Format:="Unicode Text", link:=False, _ 
      DisplayAsIcon:=False, NoHTMLFormatting:=True 
     End If 
    End Sub 
関連する問題