2017-10-10 46 views
0

我遇到了一些問題。通常,當我拉一張表時,我使用Excel中的「來自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