Excel VBA 매크로 : 여러 페이지에 걸쳐있는 사이트 테이블에서 데이터 스크랩

Question

도움을 위해 미리 감사드립니다. 저는 Windows 8.1을 실행 중이며 최신 IE/Chrome 브라우저와 최신 Excel이 있습니다. StackOverflow (https://stackoverflow.com/tags)에서 데이터를 가져 오는 Excel 매크로를 작성하려고합니다. 특히, 날짜 (매크로가 실행 됨), 태그 이름, 태그 수 및 태그의 간단한 설명을 가져 오려고합니다. 나는 테이블의 첫 번째 페이지에 대해 작업을하지만, 나머지는 수행하지 않습니다 (현재 1132 페이지가 있습니다). 지금 당장 매크로를 실행할 때마다 데이터를 덮어 씁니다. 실행하기 전에 다음 빈 셀을 찾는 방법을 모르겠습니다. 마지막으로 주당 한 번 자동으로 실행되도록 노력하고 있습니다.

여기에 도움을 주시면 감사하겠습니다. 문제는 다음과 같습니다

1. 오히려 일주일에 한 번 자동으로 매크로 실행을 만들기
2. 을 덮어 쓰지는 다음 빈 행에 데이터를 긁어 만들기 첫 페이지
3. 이상으로 웹 테이블에서 데이터를 당기면

코드 (지금까지)가 아래에 있습니다. 감사!

Enum READYSTATE 
READYSTATE_UNINITIALIZED = 0 
READYSTATE_LOADING = 1 
READYSTATE_LOADED = 2 
READYSTATE_INTERACTIVE = 3 
READYSTATE_COMPLETE = 4 
End Enum 

Sub ImportStackOverflowData() 
    'to refer to the running copy of Internet Explorer 
    Dim ie As InternetExplorer 
    'to refer to the HTML document returned 
    Dim html As HTMLDocument 
    'open Internet Explorer in memory, and go to website 
    Set ie = New InternetExplorer 
    ie.Visible = False 
    ie.navigate "http://stackoverflow.com/tags" 

    'Wait until IE is done loading page 
    Do While ie.READYSTATE <> READYSTATE_COMPLETE 
    Application.StatusBar = "Trying to go to StackOverflow ..." 
    DoEvents 
    Loop 

    'show text of HTML document returned 
    Set html = ie.document 

    'close down IE and reset status bar 
    Set ie = Nothing 
    Application.StatusBar = "" 

    'clear old data out and put titles in 
    'Cells.Clear 
    'put heading across the top of row 3 
    Range("A3").Value = "Date Pulled" 
    Range("B3").Value = "Keyword" 
    Range("C3").Value = "# Of Tags" 
    'Range("C3").Value = "Asked This Week" 
    Range("D3").Value = "Description" 

    Dim TagList As IHTMLElement 
    Dim Tags As IHTMLElementCollection 
    Dim Tag As IHTMLElement 
    Dim RowNumber As Long 
    Dim TagFields As IHTMLElementCollection 
    Dim TagField As IHTMLElement 
    Dim Keyword As String 
    Dim NumberOfTags As String 
    'Dim AskedThisWeek As String 
    Dim TagDescription As String 
    'Dim QuestionFieldLinks As IHTMLElementCollection 
    Dim TodaysDate As Date 

    Set TagList = html.getElementById("tags-browser") 
    Set Tags = html.getElementsByClassName("tag-cell") 
    RowNumber = 4 

    For Each Tag In Tags 
    'if this is the tag containing the details, process it 
    If Tag.className = "tag-cell" Then 
     'get a list of all of the parts of this question, 
     'and loop over them 
     Set TagFields = Tag.all 

     For Each TagField In TagFields 
     'if this is the keyword, store it 
     If TagField.className = "post-tag" Then 
      'store the text value 
      Keyword = TagField.innerText 
      Cells(RowNumber, 2).Value = TagField.innerText 
     End If 

     If TagField.className = "item-multiplier-count" Then 
      'store the integer for number of tags 
      NumberOfTags = TagField.innerText 
      'NumberOfTags = Replace(NumberOfTags, "x", "") 
      Cells(RowNumber, 3).Value = Trim(NumberOfTags) 
     End If 

     If TagField.className = "excerpt" Then 
      Description = TagField.innerText 
      Cells(RowNumber, 4).Value = TagField.innerText 
     End If 

     TodaysDate = Format(Now, "MM/dd/yy") 
     Cells(RowNumber, 1).Value = TodaysDate 

     Next TagField 

     'go on to next row of worksheet 
     RowNumber = RowNumber + 1 
    End If 
    Next 

    Set html = Nothing 

    'do some final formatting 
    Range("A3").CurrentRegion.WrapText = False 
    Range("A3").CurrentRegion.EntireColumn.AutoFit 
    Range("A1:C1").EntireColumn.HorizontalAlignment = xlCenter 
    Range("A1:D1").Merge 
    Range("A1").Value = "StackOverflow Tag Trends" 
    Range("A1").Font.Bold = True 
    Application.StatusBar = "" 
    MsgBox "Done!" 
End Sub 

Answer 1

데이터 탐색기 등을 통해 기본 데이터를 사용할 수있게되면 스택 오버플로를 다 쓸 필요가 없습니다. 데이터 탐색기에서이 쿼리를 사용하여 당신에게 결과를 얻을해야 당신이 필요합니다

select t.TagName, t.Count, p.Body 
from Tags t inner join Posts p 
on t.ExcerptPostId = p.Id 
order by t.count desc; 

해당 쿼리에 고유 주소가 here하고 쿼리를 실행 후 나타나는 "다운로드 CSV"옵션은 아마도를 얻을 수있는 가장 쉬운 방법입니다 데이터를 Excel에 저장합니다. 그 부분을 자동화하고 싶다면 CSV 다운로드 결과에 대한 직접 링크는 here

Answer 2

입니다. DOM을 사용하지는 않지만 알려진 태그를 검색하는 것만으로 쉽게 찾을 수 있습니다. 혹시 찾고있는 표현식이 너무 일반적이라면 문자열 뒤의 문자열을 찾도록 코드를 약간 조정하면됩니다.

예 :

Public Sub ZipLookUp() 
Dim URL As String, xmlHTTP As Object, html As Object, htmlResponse As String 
Dim SStr As String, EStr As String, EndS As Integer, StartS As Integer 
Dim Zip4Digit As String 

    URL = "https://tools.usps.com/go/ZipLookupResultsAction!input.action?resultMode=1&companyName=&address1=1642+Harmon+Street&address2=&city=Berkeley&state=CA&urbanCode=&postalCode=&zip=94703" 
    Set xmlHTTP = CreateObject("MSXML2.XMLHTTP") 
    xmlHTTP.Open "GET", URL, False 
    On Error GoTo NoConnect 
    xmlHTTP.send 
    On Error GoTo 0 
    Set html = CreateObject("htmlfile") 
    htmlResponse = xmlHTTP.ResponseText 
    If htmlResponse = Null Then 
     MsgBox ("Aborted Run - HTML response was null") 
     Application.ScreenUpdating = True 
     GoTo End_Prog 
    End If 

    'Searching for a string within 2 strings 
    SStr = "<span class=""address1 range"">" ' first string 
    EStr = "</span><br />"     ' second string 
    StartS = InStr(1, htmlResponse, SStr, vbTextCompare) + Len(SStr) 
    EndS = InStr(StartS, htmlResponse, EStr, vbTextCompare) 
    Zip4Digit = Left(Mid(htmlResponse, StartS, EndS - StartS), 4) 

    MsgBox Zip4Digit 

GoTo End_Prog 
NoConnect: 
    If Err = -2147467259 Or Err = -2146697211 Then MsgBox "Error - No Connection": GoTo End_Prog 'MsgBox Err & ": " & Error(Err) 
End_Prog: 
End Sub