2016-04-25 23 views
1

私はこのウェブサイトがあります。 http://ga.healthinspections.us/georgia/search.cfm?start=21&1=1&f=s&r=ANY&s=&inspectionType=Food&sd=03/26/2016&ed=04/25/2016&useDate=NO&county=Fulton&VBAを使用してウェブサイトから掻き集めても動作しません。何をすべきか?

を私はすでにコードを書いてきたが、それでも最初のページdoesntの仕事。任意の詳細なしでどこからのみURL現在​​のコードエキス

Column 1: 103 West Lounge (Food Service Inspections) 
Column 2: 103 WEST PACES FERRY RD ATLANTA, GA 30318 
(Skip this detail) View inspections: 
Column 3: July 10, 2012 Score: 92, Grade: A 
Column 4): July 26, 2013 Score: 90, Grade: A 
Column 5): February 19, 2014 Score: 98, Grade: A 
Column 6): December 12, 2014 Score: 100, Grade: A 
Column 6): November 13, 2015 Score: 99, Grade: A 

と内容を変更したり、間違っているを確認する必要があります:私の目標は、すべてのページからの例として、設立の詳細を以下の抽出物である

多分
Sub Test() 
Dim IE As New InternetExplorer 
Dim html As HTMLDocument 
Dim link As Object 
Dim ws As Worksheet 

Set ws = Sheets("Sheet1") 

Application.ScreenUpdating = False 
Set IE = New InternetExplorer 

' Test 2 pages (page 2 and page 3) starting from page 2. So far so good. 
For i = 2 To 4 Step 2 

myurl = "http://ga.healthinspections.us/georgia/search.cfm?start=" & i & "1&1=1&f=s&r=ANY&s=&inspectionType=Food&sd=03/26/2016&ed=04/25/2016&useDate=NO&county=Fulton&" 
IE.Visible = False 
IE.navigate myurl 
Do 
DoEvents 
Loop Until IE.readyState = READYSTATE_COMPLETE 

Set html = IE.document 
' I assume here is the problem, because I need to supplement code part to find these details. 
Set link = html.getElementsByTagName("a") 

' This part was intended to test if I can to extract at least one detail. 
For m = 1 To 2 
For Each myurl In link 
Cells(m, 1) = link 

Next 
Next m 
Next i 
'Also I tried to test with msgbox but no luck either 
'MsgBox link 

IE.quit 
Set IE = Nothing 
Application.StatusBar = "" 
Application.ScreenUpdating = True 

End Sub 

何かが台無しになったり、知識が不足しています。 :)これと助けを得ることを願っています。

答えて

0

参考資料はありますか? MicrosoftインターネットコントロールとMicrosoft HTML Object Libraryの場合もしそうなら、コードのセクションの代わりに彼を試してください。

Dim IE As New InternetExplorer 
Dim html As MSHTML.HTMLDocument 
Dim link As Object 
Dim ws As Worksheet 

Set ws = Sheets("Sheet1") 

Application.ScreenUpdating = False 
Set IE = New InternetExplorer 
+0

もちろん両方のライブラリを有効にしましたが、運はありません。 Dim html as MSHTML.HTMLDocumentも変更されました。コード自体はエラーなく実行されますが、どこからでもURLが抽出されますが、これは検索していません。私が知っているのは、Set link = html.getElementsByTagName( "a")か他の場所のために何かが抽出されないということです。 – spriteup

0

以下の方法でinnertextを取得できます。

Sub DumpData() 

Set IE = CreateObject("InternetExplorer.Application") 
IE.Visible = True 

URL = "http://ga.healthinspections.us/georgia/search.cfm?start=1&1=1&f=s&r=ANY&s=&inspectionType=Food&sd=03/26/2016&ed=04/25/2016&useDate=NO&county=Fulton&" 

'Wait for site to fully load 
IE.Navigate2 URL 
Do While IE.Busy = True 
    DoEvents 
Loop 

RowCount = 1 

With Sheets("Sheet1") 
    .Cells.ClearContents 
    RowCount = 1 
    For Each itm In IE.Document.all 
     .Range("A" & RowCount) = itm.tagName 
     .Range("B" & RowCount) = itm.ID 
     .Range("C" & RowCount) = itm.className 
     .Range("D" & RowCount) = Left(itm.innerText, 1024) 

     RowCount = RowCount + 1 
    Next itm 
End With 
End Sub 

私はJoelという名前の偉大な人からそれを得ました。彼はこのものと賢い人です。

データをシートにインポートしたら、簡単なクリーニングを行い、不要なものを取り除き、すべての設定を行う必要があります。

+0

こんにちは。ジョエルとあなたに感謝します。少なくとも何かがありますが、私は893ページのマニュアルクリーニングはしません。あまりにも大きな混乱があります。 :) – spriteup

関連する問題