rand(life)

[VBA]웹 스크랩핑 본문

컴퓨터/엑셀

[VBA]웹 스크랩핑

flogsta 2020. 11. 18. 07:40

아직 배우는 중

미천한 HTML 지식과 검색으로 웹 스크래핑을 공부하고 있다

아래는 검색해서 얻은 코드. 주석을 붙여보았다.

일단 참조에서 아래와 같이 추가해야한다

대부분 위의 4개는 이미 추가가 되어있을테고, 아래의 2개만 추가하면 된다(엑셀 365기준)

MICROSOFT WinHTTP Services

MICROSOFT HTML Object Library

원 글에서는 네이버 뉴스도 가져오는 코드가 있지만, 그동안 네이버 뉴스가 개편을 한 탓인지 제대로 작동을 안해서 다음 뉴스만 가져오도록 했다.

가능한 주석을 달아보았는데, 아직 공부할 것이 많다.

.getElementById 하고

getElementsByTagName 의 사용법이 아직 완전하지 않다.

<id ~~>  이렇게 되어있는 곳을 가져오는 것 같은데, 테스트삼아 다른 사이트에서 해봤더니 잘 안된다. HTML공부를 좀 더 해야 가능할 듯

Option Explicit

Function request(url As String)

    Dim whttp As Object
    Set whttp = CreateObject("WinHttp.WinHttpRequest.5.1")
    whttp.Open "GET", url
    whttp.SetRequestHeader "user-agent", "Mozilla/5.0 (Windows NT 10.0; Win64; x64) AppleWebKit/537.36 (KHTML, like Gecko) Chrome/80.0.3987.116 Safari/537.36"
    whttp.Send
    whttp.WaitForResponse
    request = whttp.ResponseText

End Function

Sub insertSht(args() As String) '배열 변수를 받아서 차곡 차곡 정리한다!

    With Sheets(args(0)).Range("a1000000").End(xlUp)
        .Offset(1, 0) = args(1) '사이트 분류
        .Offset(1, 1) = args(2) '제목
        .Offset(1, 2) = args(3) '기사 정보
        .Offset(1, 3) = args(4) '본문 일부
        .Offset(1, 4) = args(5) '본문 링크
    End With
    
End Sub

Sub daumParser(response As String)

    Dim doc As Object
    Dim elements As IHTMLElementCollection
    Dim element As IHTMLElement
    Dim args(5) As String
    Dim elIdx As Integer
    
    Set doc = New HTMLDocument
    'doc도 하나의 HTML문서임
    doc.body.innerHTML = response
    '위에서 받은 전체내용을 doc의 <body> </body> 사이의 innerHtMl값으로 넣음
    doc.body.innerHTML = doc.getElementById("newsResultUL").innerHTML
    '받은 전체 html 중에서 newsResultUL이라는 id 아래의 html을 doc의 <body> </body> 사이의 innerHtMl값으로 다시 수정
    
    Set elements = doc.getElementsByTagName("li")
    '<li> 태그아래의 요소들 컬렉션 정의
    For Each element In elements '컬렉션 내의 각 항목에 대해
    '뒤에 img가 있는 기사와 없는 기사의 본문 배열 순서가 다르므로
        If element.getElementsByTagName("img").Length > 0 Then
            elIdx = 2
        Else
            elIdx = 1
        End If
        
        args(0) = "sheet1"
        args(1) = "Daum"
        'li 태그 아래에 div 태그 중 2번째(1) 또는 3번째에 있는 <a> 태그 중 첫번째 a 태그안의 텍스트
        args(2) = element.getElementsByTagName("div")(elIdx).getElementsByTagName("a")(0).innerText
        'li 태그 아래에 div 태그 중 2번째(1) 또는 3번째에 있는 <span> 태그 중 첫번째 span태그 안의 텍스트
        args(3) = element.getElementsByTagName("div")(elIdx).getElementsByTagName("span")(0).innerText
        args(4) = element.getElementsByTagName("div")(elIdx).getElementsByTagName("p")(0).innerText
        'a 태그 안의 접속 주소
        args(5) = element.getElementsByTagName("div")(elIdx).getElementsByTagName("a")(0).href
        Call insertSht(args)
    Next

End Sub




Sub main() '뉴스 수집 모듈 제어

    Dim naverNewsHeadUrl, naverNewsTailUrl As String
    Dim daumNewsHeadUrl, daumNewsTailUrl As String
    Dim keyword, requestUrl As String
    Dim page As Integer
    
    keyword = "코로나"
    
    Sheets("sheet1").Range("A:E").Delete
    With Sheets("sheet1").Range("a1")
        .Offset(0, 0) = "사이트"
        .Offset(0, 1) = "제목"
        .Offset(0, 2) = "기사 정보"
        .Offset(0, 3) = "본문 일부"
        .Offset(0, 4) = "본문 주소"
    End With
    
     daumNewsHeadUrl = "https://search.daum.net/search?w=news&sort=recency&q="
    daumNewsTailUrl = "&cluster=n&DA=PGD&dc=STC&pg=1&r=1&rc=1&at=more&p="
    
    
    For page = 1 To 10 '페이지까지 반복하며 내용을 가져온다!
        Debug.Print ("request Page Number : " & page)
       
        requestUrl = daumNewsHeadUrl & keyword & daumNewsTailUrl & page '다음 기사 요청
        daumParser (request(requestUrl)) '다음 요청 결과 파싱
        
        Application.Wait (Now + TimeSerial(0, 0, 1))
    Next
    
End Sub
'컴퓨터/엑셀' Related Articles more