2015-07-08 2 views
2

Я пытаюсь очистить некоторые данные из базы данных, и у меня это довольно много. Я смотрю в IE для вкладки, в которой я зарегистрировался в базе данных, и вставьте ссылку запроса через vba. Но как я извлекаю данные, которые он возвращает с вкладки IE, и помещает их в ячейку или массив excel.Импорт/очистка веб-сайта в excel

Это код, у меня есть для открытия моего запроса:

Sub import() 
Dim row As Integer 
Dim strTargetFile As String 
Dim wb As Workbook 
Dim test As String 
Dim ie As Object 


Call Fill_Array_Cultivar 

For row = 3 To 4 

    Sheets.Add.Name = Cultivar_Array(row, 1) 
    strTargetFile = "https://www3.wipo.int/pluto/user/jsp/select.jsp?fl=app_date%2Cden_info%2Cden_final&hl=false&json.nl=map&wt=json&type=upov&start=0&qi=3-nNCXQ6etEVv184O9nnd5yg%3D%3D&q=cc%3AIT%20AND%20latin_name%3A(zea%20mays)%20AND%20den_info%3A" & Trim(Cultivar_Array(row, 1)) & "&facet=false" 

     Set ie = GetIE("https://www3.wipo.int" & "*") 
     If Not ie Is Nothing Then 

      ie.navigate (strTargetFile) 

Else 
    MsgBox "IE not found!" 
End If 
Next row 

End Sub 

И это соответствующая функция:

'Find an IE window with a matching (partial) URL 
'Assumes no frames. 
Function GetIE(sAddress As String) As Object 

Dim objShell As Object, objShellWindows As Object, o As Object 
Dim retVal As Object, sURL As String 


    Set retVal = Nothing 
    Set objShell = CreateObject("Shell.Application") 
    Set objShellWindows = objShell.Windows 

'see if IE is already open 
    For Each o In objShellWindows 
     sURL = "" 
     On Error Resume Next 
     sURL = o.document.Location 
     On Error GoTo 0 
     If sURL <> "" Then 
      If sURL Like sAddress & "*" Then 
       Set retVal = o 
       Exit For 
      End If 
     End If 
    Next o 

Set GetIE = retVal 
End Function 

Что сайт возвращается ко мне белая страница с линией текст. Вот пример:

{"response":{"start":0,"docs":[{"den_final":"Abacus","app_date":"1998-01-13T22:59:59Z"}],"numFound":1},"qi":"3-nNCXQ6etEVv184O9nnd5yg==","sv":"bswa2.wipo.int","lastUpdated":1436333633993} 

PS. Я также попытался использовать функцию importxml, он будет импортировать веб-сайт, но только страницу с ошибкой, так как он не признает меня вошедшим в систему.

ответ

0

Я нашел решение, которое было довольно простым, но трудно найти. Я могу просто захватить ie.Document.body.innertext, который является всем текстом, который мне нужен. См. Код, который я обновил ниже:

Sub import() 
Dim row As Integer 
Dim strTargetFile As String 
Dim wb As Workbook 
Dim test As String 
Dim ie As Object 
Dim pageText As String 

Call Fill_Array_Cultivar 

For row = 3 To 4 

    Sheets.Add.Name = Cultivar_Array(row, 1) 
    strTargetFile = "https://www3.wipo.int/pluto/user/jsp/select.jsp?fl=app_date%2Cden_info%2Cden_final&hl=false&json.nl=map&wt=json&type=upov&start=0&qi=3-nNCXQ6etEVv184O9nnd5yg%3D%3D&q=cc%3AIT%20AND%20latin_name%3A(zea%20mays)%20AND%20den_info%3A" & Trim(Cultivar_Array(row, 1)) & "&facet=false" 

    Set ie = GetIE("https://www3.wipo.int" & "*") 
    If Not ie Is Nothing Then 
     ie.navigate (strTargetFile) 

     Do Until ie.ReadyState = 4: DoEvents: Loop 

     pageText = ie.Document.body.innertext 
     ActiveSheet.Cells(1, 1) = pageText 
     pageText = Empty 
    Else 
     MsgBox "IE not found!" 
    End If 
Next row 
End Sub