네이버 뉴스 검색 결과 가져오기

안녕하세요.

 

네이버 뉴스에서 검색해서 결과를 가져오는 VBA 코드입니다.

 

완성 파일 다운로드

네이버 뉴스 검색 결과 가져오기.xlsm

0.02MB

 

'검색'은 URL을 C열에 나타내고, '검색2'는 A열에 링크를 걸어 나타냅니다.

'초기화'는 검색 결과를 모두 지웁니다.

 

 

 

Public Sub 초기화()
    Range("5:1048576").Clear
End Sub

Public Sub 검색()
    r = 5
    키워드 = Range("A2").Value
    
    For Page = 1 To 10
        Start = (Page - 1) * 10 + 1
        Set doc = GetDocumentByUrl("https://search.naver.com/search.naver?where=news&sm=tab_jum&query=" & 키워드 & "&start=" & Start)
        
        For i = 0 To 9
            Cells(r, 1).Value = doc.queryselectorall(".news_tit").Item(i).innertext
            Cells(r, 2).Value = doc.queryselectorall(".api_txt_lines").Item(i).innertext
            Cells(r, 3).Value = doc.queryselectorall(".news_tit").Item(i).href
            
            Rows(r).Select
            DoEvents
            
            r = r + 1
        Next
    Next
End Sub

Public Function GetDocumentByUrl(URL)
    Set WinHttp = CreateObject("WinHttp.WinHttpRequest.5.1")
    Set document = CreateObject("Htmlfile")
    
    WinHttp.Open "GET", URL, False
    WinHttp.send
    
    document.body.innerhtml = WinHttp.responsetext
    
    Set GetDocumentByUrl = document
End Function

Public Sub 검색2()
    r = 5
    키워드 = Range("A2").Value
    
    For Page = 1 To 10
        Start = (Page - 1) * 10 + 1
        Set doc = GetDocumentByUrl("https://search.naver.com/search.naver?where=news&sm=tab_jum&query=" & 키워드 & "&start=" & Start)
        
        For i = 0 To 9
            
            ActiveSheet.Hyperlinks.Add Anchor:=Range("A" & r), _
                Address:=doc.queryselectorall(".news_tit").Item(i).href, _
                TextToDisplay:=doc.queryselectorall(".news_tit").Item(i).innertext
            
            Cells(r, 2).Value = doc.queryselectorall(".api_txt_lines").Item(i).innertext
            
            Rows(r).Select
            DoEvents
            
            r = r + 1
        Next
    Next
End Sub