[VBA] 네이버 영어사전 LV4.(댓글 요청)

네이버 영어사전 LV3.의 약간의 버그가 있어 수정해서 올림으로 22년을 마감하려한다.

기존 파일은 검색하는 단어가 없을시 런타임오류가 발생하였다고 하여 수정하여 올린다.

https://1stminokingdom.tistory.com/119

[VBA] 네이버사전 Lv3.

 

크게 변동된게 없고, 다소 복잡하게 보여서 Function으로 하이퍼링크 부분만 처리하였다.

 

Option Explicit
Sub Haja_word_Lv4()

    Dim rngAll As Range: Set rngAll = Range([a2], Cells(Rows.Count, "a").End(3))    '= 단어 영역 순환
    Dim rngA As Range
    Dim html As Object: Set html = CreateObject("htmlfile")
    Dim xmlHttp As Object: Set xmlHttp = CreateObject("msxml2.xmlhttp")
    Dim strUrl$, strplay$
    
    rngAll.Next.Resize(rngAll.Rows.Count, 2).ClearContents
    ActiveSheet.UsedRange.Borders.LineStyle = xlNone
    
    Application.ScreenUpdating = False
    For Each rngA In rngAll                                                         '= 각 단어를 순환해라
    
        On Error Resume Next
            strUrl = "https://dict.naver.com/search.nhn?query=" & rngA                  '= 네이버사전에서 순환하면서 단어를 검색해라
            
            With xmlHttp
                .Open "get", strUrl, False
                .send
                html.body.innerhtml = .responsetext
                
                If InStr(html.body.innerhtml, "단어의 철자가 정확한지 확인해 보세요.") > 0 Then rngA(1, 3) = "단어의 철자를 확인하세요": GoTo haja
                strplay = Split(Split(.responsetext, "a playlist=""")(1), """ class=")(0) '= 음성파일 핑크 영역
            End With
                
                
                rngA(1, 2) = Haja_HyLink(html.queryselector(".fnt_e25").innertext, strplay, rngA(1, 2))                            '= 발음 기호부분
                
                rngA(1, 3) = html.queryselector("#content > div.en_dic_section.search_result.dic_en_entry > dl > dd:nth-child(2)").innertext
                strplay = ""
              
        On Error GoTo 0
haja:
    Next rngA
    
    [a1].CurrentRegion.Borders.LineStyle = 1
    Application.ScreenUpdating = False
    MsgBox "하자님의 Lv4 영어사전 추출이 완료되었습니다."
    
End Sub

Function Haja_HyLink(str$, strplay$, rngX As Range)

        ActiveSheet.Hyperlinks.Add anchor:=rngX, Address:=strplay, ScreenTip:="[웹브라우저 연결]"  '= 발음기호 하이퍼링크 연결
        
        rngX.Font.Underline = xlUnderlineStyleNone
        rngX.Font.Color = rgbDarkBlue
        rngX.Font.Bold = True
        
        Haja_HyLink = str


End Function

네이버영어사전4(22.12.31).xlsm

0.03MB