네이버 오늘의 단어 가져오기

VBA로 네이버 오늘의 단어 가져오기

URL: http://m.wordbook.naver.com/endic/today/recite.nhn?targetDate=2018.04.09

기능: 시트이름이 Daily, Monthly, Weekly 로 시작하면 각각 날짜별, 달별, 일주일별 오늘의 단어 5개씩을 가져옴

사용 개체: WinhttpRequest, HTMLDocument, IHTMLElementCollection 등을 이용함.

HTML을 파싱할 때 Split, Instr 을 이용하지 않고 GetElementBYTagName 을 이용함.

사용방법:

매크로를 허용하고 연 다음

왼쪽 상단 '날짜선택'을 누르고 대상 날짜를 입력.

오늘 날짜가 자동으로 뜸.

현재 선택된 시트이름이 Daily, Weekly, Monthly 로 시작할 때 각각 일자별, 일주일별, 달별 단어를 5개씩 파싱을 통해 가져옴.

따라서 시트이름을 "Weekly임시" 이런 식으로 바꾸고 검색하면 일주일치를 검색함.

용도:

단어 공부

또는 퀴즈 자료로 이용

단어 수준:

수능보다 약간 높은 수준으로 취업준비생 수준의 어휘로 판단됨.

저작권:

단어목록의 저작권은 원 저작권자(Naver 등)에게 있음.

이 매크로는 단지 단어공부의 편의와 HTML Parsing 공부를 위해 개인적으로 사용되는 용도임.

추가 기능:

단어 검색시 시간이 걸리므로 progress bar 로 진행상황을 보여줌.

날짜나 단어를 누르면 해당 웹페이지로 하이퍼링크됩니다.

발음을 누르면 발음 파일로 링크됩니다. 검색후 시간이 많이 지나면 링크상의 소리파일이 사라지므로 다시 검색후 발음을 눌러야 합니다.

단어는 항상 예문 속에서 익혀야 제대로 사용법을 알 수 있습니다. 예문을 잘 읽어봅시다.

생성된 시트는 다른이름으로 저장해 놓을 수 있습니다.

Sub GetWordList()
    Dim usr As String, msg As VbMsgBoxResult
    Dim Target As Collection
    Dim sht As Worksheet
    Dim CurDate As Date, StartDate As Date, EndDate As Date
    Dim i As Integer
    
    Set Target = New Collection
    Set sht = ActiveSheet
    
    usr = InputBox("대상 날짜를 '2018-01-01' 형식으로 입력하세요:" & vbNewLine & vbNewLine & _
        "대상기간은 시트이름이 Monthly, Weekly, Daily 로 시작할 때 각각 다릅니다.", "네이버 오늘의 단어", Format(Date, "yyyy-mm-dd"))
    If Len(usr) <> 10 Then Exit Sub
    CurDate = DateSerial(Left(usr, 4), Mid(usr, 6, 2), Right(usr, 2))
 
'    With sht.Shapes("Button 1").OLEFormat.Object
'        .Text = Format(CurDate, "yyyy-mm-dd")
'        .Font.Size = 9
'    End With
    
'    If Cells(1, 1).NumberFormat = "General" Then
'        CurDate = DateSerial(Year(Left([A1], 4)), Month(Mid([A1], 6, 2)), Day(Right([A1], 2)))
'    ElseIf Cells(1, 1).NumberFormat = "yyyy-mm-dd" Then
'        CurDate = CDate(Cells(1, 1))
'    Else
'        MsgBox "[A1]셀에 '2018-01-01' 형식으로 입력하세요.": Exit Sub
'    End If
    
    If sht.Name Like "Weekly*" Then
        StartDate = CurDate - Weekday(CurDate, vbUseSystemDayOfWeek) + 1
        For i = 0 To 6
            Target.Add Format(StartDate + i, "yyyy-mm-dd")
        Next i
    ElseIf sht.Name Like "Monthly*" Then
        StartDate = DateSerial(Year(CurDate), Month(CurDate), 1)
        EndDate = DateSerial(Year(CurDate), Month(CurDate) + 1, 0)
        For i = 0 To Day(EndDate) - 1
            Target.Add Format(StartDate + i, "yyyy-mm-dd")
        Next i
    Else
        Target.Add CurDate 'Cells(1, "A").Value
    End If
    
    If Target.Count > 1 Then
        msg = MsgBox(Format(StartDate, "yyyy-mm-dd") & "부터 " & Target.Count & _
            "일간의 데이터를 가져옵니다.", vbOKCancel, "데이터 가져오기 시작")
        If msg = vbCancel Then Exit Sub
    End If
    GetDailyWordList Target
    Set Target = Nothing
End Sub
 
Function GetDailyWordList(TargetDates As Collection)
    
    Dim sht As Worksheet
    Dim Winhttp As WinHttpRequest
    Dim Html As HTMLDocument, Html2 As HTMLDocument
    Dim Result As IHTMLElementCollection
    Dim Url As String
    Dim wordlist As Object
    Dim i As Long
    Dim str As String
    
On Error Resume Next
    Set Winhttp = New WinHttpRequest
    Set Html = New HTMLDocument
    Set Html2 = New HTMLDocument
    
    Set sht = ActiveSheet
    Rows("2:" & Rows.Count).Clear
 
    UserForm1.Show vbModeless   'progress bar
    'Application.ScreenUpdating = False
    
    For Each TargetDate In TargetDates
 
        'Url = "http://m.wordbook.naver.com/endic/today/words.nhn?targetDate=" & TargetDate
        Url = "http://m.wordbook.naver.com/endic/today/recite.nhn?targetDate=" & _
            Format(TargetDate, "yyyy.mm.dd")
        With Winhttp
            .Open "Get", Url
            .send
            .WaitForResponse
            Html.body.innerHTML = .responseText
            
            Set Result = Html.getElementsByClassName("entryPage book_bg3")
            For Each wordlist In Result
 
                i = i + 1
                Html2.body.innerHTML = wordlist.innerHTML
                'Date
                Cells(1 + i, 1).Value = TargetDate & "(" & _
                    WeekdayName(Weekday(TargetDate, vbUseSystemDayOfWeek), True, vbUseSystemDayOfWeek) & ")"
                Cells(1 + i, 1).NumberFormat = "yyyy-mm-dd"
                sht.Hyperlinks.Add anchor:=Cells(1 + i, 1), _
                                    Address:=Url, _
                                    ScreenTip:="Daily words(Web)"
                Cells(1 + i, 1).Font.Underline = xlUnderlineStyleNone
                Cells(1 + i, 1).Font.ColorIndex = xlAutomatic
                Cells(1 + i, 1).ShrinkToFit = True
                'index
                Cells(1 + i, 2).Value = i
                '단어
                Cells(1 + i, 3).Value = Html2.getElementsByTagName("a")(1).innerText
                sht.Hyperlinks.Add anchor:=Cells(1 + i, 3), _
                    Address:=Html2.getElementsByTagName("a")(1).href, _
                    ScreenTip:="Search(via WebBrowser)"
                Cells(1 + i, 3).Font.Underline = xlUnderlineStyleNone
                Cells(1 + i, 3).Font.Color = rgbDarkBlue
                Cells(1 + i, 3).Font.Bold = True
                '발음기호
                str = Html2.getElementsByClassName("cen_dn")(0).innerText
                Cells(1 + i, 4).Value = IIf(Len(str), str, "Listen")
                '발음듣기
                'Cells(1 + i, 5).Value = Html2.getElementsByTagName("a")(2).getAttribute("title")
                sht.Hyperlinks.Add anchor:=Cells(1 + i, 4), _
                    Address:=Html2.getElementsByTagName("a")(2).getAttribute("data-purl"), _
                    ScreenTip:="Listen(via WebBrowser)"
                Cells(1 + i, 4).Font.Underline = xlUnderlineStyleNone
                Cells(1 + i, 4).Font.ColorIndex = xlAutomatic
                '뜻
                Cells(1 + i, 5).Value = Html2.getElementsByClassName("cen_txt_sub")(0).innerText
                'Cells(1 + i, 5).ShrinkToFit = True
                '예문
                str = Html2.getElementsByClassName("cen_dn tts_area")(0).innerText
                If Right(str, 4) = "play" Then str = Left(str, Len(str) - 4): _
                Cells(1 + i, 6).Value = str: _
                Cells(1 + i, 6).IndentLevel = 1
                
                Cells(1 + i, 7).Value = Html2.getElementsByClassName("cen_dn")(2).innerText
                Cells(1 + i, 7).ShrinkToFit = True
                
            Next wordlist
        End With
        
        UserForm1.ProgressBar1.Value = CInt((i / TargetDates.Count) * 100)
        
    Next TargetDate
    
    Set Html2 = Nothing
    Set Html = Nothing
    Set Winhttp = Nothing
    
    Unload UserForm1
    'Application.ScreenUpdating = True
End Function
 

** Download:

네이버_오늘의단어.xlsm