컴퓨터 공부/엑셀 & VBA

[엑셀vba] 인터넷 익스플로러 컨트롤하기 3(웹 크롤링)

도 박사 2020. 6. 24. 00:21
반응형

[엑셀vba] 인터넷 익스플로러 컨트롤 하기 1

 

[엑셀vba] 인터넷 익스플로러 컨트롤 하기 1

[엑셀vba] 인터넷 익스플로러 컨트롤하기 2(자동로그인) [엑셀vba] 인터넷 익스플로러 컨트롤하기 2(자동로그인) 이전글: [엑셀vba] 인터넷 익스플로러 컨트롤 하기 1 엑셀VBA로 옥션에 자동로그인을

godofexcel.tistory.com

[엑셀vba] 인터넷 익스플로러 컨트롤하기 2(자동로그인)

 

[엑셀vba] 인터넷 익스플로러 컨트롤하기 2(자동로그인)

이전글: [엑셀vba] 인터넷 익스플로러 컨트롤 하기 1 엑셀VBA로 옥션에 자동로그인을 해보자. 준비물 옥션 계정 정보, 옥션 로그인 주소, 크롬, 인터넷 익스플로러 매크로 진행 계획 인터넷 익스플�

godofexcel.tistory.com

 

엑셀vba를 이용해서 네이버 뉴스속보를 엑셀 시트에 기록해보자.

 

기록할 내용은 '뉴스 제목', '작성 시간', '신문사' + 제목을 클릭하면 신문기사 페이지로 이동하도록 하겠다. 

 


  • 매크로 동작 순서
  1. 매크로 실행
  2. 인터넷 익스플로러가 열리고
  3. 네이버 정치 속보 페이지로 이동하며
  4. 첫 페이지 나타난 뉴스들을 엑셀 시트에 기록함
  5. 끄읕

  • 매크로 동작 영상
네이버 정치 속보 뉴스 크롤링하기

  • 매크로 만들기

 

1. 네이버 정치 속보 페이지 열기

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
Sub 네이버_뉴스_속보_가져오기()
    
    Dim IE_ctrl As InternetExplorer '익스플로러 변수
    Dim HTMLDoc As IHTMLDocument 'html소스 들어갈 변수
    Dim News_Data As IHTMLElement '뉴스 데이터 들어갈 변수
    Dim URL As String 'url 주소 입력
    Dim LastCell As Integer '마지막 셀 위치 확인
    
    URL = "https://news.naver.com/main/list.nhn?mode=LSD&mid=sec&sid1=100&listType=title&date=" & Year(Date& Month(Date& Day(Date)
 
    Set IE_ctrl = New InternetExplorer
    IE_ctrl.Silent = True
    IE_ctrl.Visible = True
    IE_ctrl.navigate URL
    
End Sub
cs

 

네이버 정치 속보 URL을 살펴보면 마지막에 '20200623' 같은 날짜 형식으로 파라미터가 들어감

그래서 URL 마지막에 오늘 날짜가 들어가도록 작성함

 

& Year(Date) & Month(Date) & Day(Date)

또는

& Replace(Date, "-", "")

 

* '&' 문자를 이어주는 역할:   string = "a" & "b"  ->> string 에는 "ab" 저장

* date 함수: 오늘 날짜 나타내줌

* replace 함수: replace("ABBB", "A" , "B"), ABBB 문자열에서 A를 B로 바꿔줌.

* year 함수: year(2020-06-07), 날짜 형식의 데이터에서 년도만 추출. 2020만 나옴

- month: 월만 추출, day:일만 추출

 


2. html 소스 분석

 

네이버 정치 속보 페이지에서 어떤 클래스를 이용해 뉴스 정보를 어떻게 불러올지 소스 분석으로 알아봄

 

뉴스 데이터가 들어있는 태그의 클래스

 

 type02 클래스 아래에 뉴스 정보가 들어있음

네이버 뉴스는 'type02' 클래스 안에 5개의 뉴스가 있고, 'type02'는 10개가 존재함

그렇다는건 한 페이지에 총 50개의 뉴스가 있다는 얘기가 됨

 

이제 50개의 뉴스를 엑셀 시트에 기록해보자.


3. 코드 작성

 

 

[뉴스 속보가져오는 코드 전문]

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
Sub 네이버_정치_속보_가져오기()    
    Dim IE_ctrl As InternetExplorer
    Dim HTMLDoc As IHTMLDocument
    Dim News_Data As IHTMLElement
    Dim URL As String
    Dim LastCell As Integer
    
    On Error GoTo Err_Check
    
    LastCell = Sheets(1).Cells(Rows.Count, "A").End(xlUp).Row + 1
    
    URL = "https://news.naver.com/main/list.nhn?mode=LSD&mid=sec&sid1=100&listType=title&date=" & Replace(Date"-""")
 
    Set IE_ctrl = New InternetExplorer
    IE_ctrl.Silent = True
    IE_ctrl.Visible = False
    IE_ctrl.navigate URL
    
    '--------------------------------------------------------------------------------------------------
 
    Wait_Browser IE_ctrl
    
    Set HTMLDoc = IE_ctrl.Document
    
    For Each News_Data In HTMLDoc.getElementsByClassName("type02")
    
        For i = 0 To 4
              
            Cells(LastCell, "B"= News_Data.Children.Item(i).Children.Item(0).innerText
            Cells(LastCell, "C"= News_Data.Children.Item(i).Children.Item(2).innerText
            Cells(LastCell, "A"= News_Data.Children.Item(i).Children.Item(3).innerText
                        
            If Len(News_Data.Children.Item(i).Children.Item(4).innerText) Then
                
                Cells(LastCell, "A"= News_Data.Children.Item(i).Children.Item(4).innerText
            
            End If
            
            If Cells(LastCell, "A"= "" Then
                Cells(LastCell, "C"= News_Data.Children.Item(i).Children.Item(1).innerText
                Cells(LastCell, "A"= News_Data.Children.Item(i).Children.Item(2).innerText
            End If
            
            '하이퍼링크 작업 시작
            '--------------------
            URL = Mid(News_Data.Children.Item(i).outerHTML, InStr(1, News_Data.Children.Item(i).outerHTML, "href="+ 6)
            URL = Left(URL, InStr(1, URL, ">"- 2)
            URL = Replace(URL, "amp;""")
            Sheets(1).Hyperlinks.Add Cells(LastCell, "B"), URL
            '-------------------
            '하이퍼링크 작업 끝
            LastCell = LastCell + 1
        Next i
    Next
   
    Exit Sub
    
Err_Check:
        If Err <> 0 Then
            Err.Clear
            Resume Next
        End If
 
End Sub
cs

 

 

[뉴스 데이터 가져오는 코드]

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
For Each News_Data In HTMLDoc.getElementsByClassName("type02")
    
        For i = 0 To 4
              
            Cells(LastCell, "B"= News_Data.Children.Item(i).Children.Item(0).innerText
            Cells(LastCell, "C"= News_Data.Children.Item(i).Children.Item(2).innerText
            Cells(LastCell, "A"= News_Data.Children.Item(i).Children.Item(3).innerText
                        
            If Len(News_Data.Children.Item(i).Children.Item(4).innerText) Then
                
                Cells(LastCell, "A"= News_Data.Children.Item(i).Children.Item(4).innerText
            
            End If
            
            If Cells(LastCell, "A"= "" Then
                Cells(LastCell, "C"= News_Data.Children.Item(i).Children.Item(1).innerText
                Cells(LastCell, "A"= News_Data.Children.Item(i).Children.Item(2).innerText
            End If
            
            '하이퍼링크 작업 시작
            '--------------------
            URL = Mid(News_Data.Children.Item(i).outerHTML, InStr(1, News_Data.Children.Item(i).outerHTML, "href="+ 6)
            URL = Left(URL, InStr(1, URL, ">"- 2)
            URL = Replace(URL, "amp;""")
            Sheets(1).Hyperlinks.Add Cells(LastCell, "B"), URL
            '-------------------
            '하이퍼링크 작업 끝
            LastCell = LastCell + 1
        Next i
    Next
cs

 

Set HTMLDoc = IE_ctrl.Document '열린 url 페이지의 소스코드를 불러옴

 

For Each News_Data In HTMLDoc.getElementsByClassName("type02") '소스코드에서 'type02' 라는 이름을 가진 클래스 정보를 가져옴

     For i = 0 to 4

 

          Cells(LastCell, "B") = News_Data.Children.Item(i).Children.Item(0).innerText '제목 추출

          Cells(LastCell, "C") = News_Data.Children.Item(i).Children.Item(2).innerText '신문사 추출

          Cells(LastCell, "A") = News_Data.Children.Item(i).Children.Item(3).innerText '등록시간 추출

  '네이버 뉴스에서 뉴스 데이터를 가진 칠드런은 4가지로 구성되어 있음. 

  ' Item(1) = 뉴스제목, Item(2) = 뉴스 영상, 이미지 여부, Item(3) = 신문사, Item(4) = 등록시간

          

 

          If len(Cells(LastCell, "A") = News_Data.Children.Item(i).Children.Item(4).innerText)  Then

              Cells(LastCell, "A") = News_Data.Children.Item(i).Children.Item(4).innerText

          End if

  '간혹가다 칠드런 5개로 구성되있는 경우 있음. 다섯번째 칠드런 존재 확인하고 있으면 셀에 등록시간 기록

 ' Item(1) = 뉴스제목, Item(2) = 뉴스 영상, 이미지 여부, Item(3) = 신문사, Item(4) = 신문기재표시, Item(5) = 등록시간

 

          If Cells(LastCells,"A") = "" Then

              Cells(LastCell, "C") = News_Data.Children.Item(i).Children.Item(1).innerText

              Cells(LastCell, "A") = News_Data.Children.Item(i).Children.Item(2).innerText

          End if

          ' 이미지나 영상이 없는 뉴스는 칠드런이 3가지로 구성되어 있어서 따로 구분해줌

     Next i

Next


 

반응형