네이버 사전 검색 및 발음 mp3 자동 다운로드

단어 리스트에 대해

실시간으로 네이버사전을 검색해서

첫번째 뜻과 예문 등을 가져오고

또한 해당 단어 발음(첫번째 미국식)을 Mp3폴더에 자동으로 다운 받는 매크로입니다.

 

 

 

사용법:

첨부파일을 다운받고 매크로 컨텐츠를 허용합니다.

2행부터는 삭제해도 됩니다.

B열에 Word 아래에 단어목록을 적습니다.

많이 적을 수록 검색 시간이 길어집니다.

좌측 상단 '검색' 버튼을 누르면

위 화면과 같이 네이버 영어사전에서 단어를 검색합니다.

Mp3폴더 아래에 단어명.mp3 파일을 다운로드합니다.

(매크로 파일이 있는 폴더에 Mp3폴더가 미리 있어야 합니다.)

 

1.각 단어에는 해당단어에 대한 네이버사전으로 하이퍼링크가 추가됩니다.

자세히 알고 싶을 때 클릭하면 브라우져 창이 열립니다.

 

2. 발음기호를 클릭하면 다운 받은 mp3에 대한 하이퍼링크가 걸립니다.

mp3에 걸린 하이퍼링크를 클릭하면 보안 경고가 뜹니다.

이걸 해제하려면 Alt-F8을 누르고 KillHyperlink~ 매크로를 실행하면

경고가 뜨지 않도록 레지스트리를 수정합니다.

 

3. 예문과 예문 해석도 조회가 됩니다.

간혹 서로 뒤바뀔 때가 있습니다.

 

아울러, 어떤 경우에는 발음이 없거나 예문이 검색이 되지 않을 수도 있습니다.

특히 두개 이상의 단어로 이루어진 경우 첫단어나 마지막 단어만 검색될 수 있습니다.

네이버 사전에 대한 링크는 제대로 링크가 되어 있습니다.

 

 

Option Explicit
 
Declare PtrSafe Function URLDownloadToFile Lib "urlmon" Alias "URLDownloadToFileA" _
    (ByVal pCaller As Long, ByVal szURL As String, ByVal szFileName As String, _
    ByVal dwReserved As Long, ByVal lpfnCB As Long) As Long
 
Sub GetWordList()
 
    Dim sht As Worksheet
    Dim i As Long
    Dim LastRow As Long
    Dim Rng As Range
    
    Dim XMLhttp As ServerXMLHTTP  'WinHttpRequest
    Dim Html As HTMLDocument, Html2 As HTMLDocument
    Dim Result As IHTMLElementCollection
    Dim Url As String, str As String
    Dim wordlist As Object
    Dim TargetUrl As String, LocalFile As String
    
    On Error Resume Next
    Set XMLhttp = New ServerXMLHTTP ' WinHttpRequest
    Set Html = New HTMLDocument
    Set Html2 = New HTMLDocument
        
    Set sht = ActiveSheet
    sht.Hyperlinks.Delete
    
    UserForm1.Show vbModeless   'progress bar
    'Application.ScreenUpdating = False
    
    LastRow = sht.Cells(sht.Rows.Count, 2).End(xlUp).Row
    
    For Each Rng In sht.Range("B2:B" & LastRow)
        str = vbNullString
        Url = "https://endic.naver.com/search.nhn?sLn=kr&query=" & Rng.Value
    
        With XMLhttp
            .Open "Get", Url
            .setRequestHeader "User-Agent", "Mobile"
            .send
            .WaitForResponse
            Html.body.innerHTML = .responseText
        End With
        
        '인덱스
        i = i + 1
        Rng.Offset(, -1).Value = i
        
        '단어에 웹링크
        Set Result = Html.getElementsByClassName("fnt_e30")
        If Result.Length Then
            'str = Html.getElementsByClassName("N=a:wrd.entry")(0).getAttribute("href")
            Html2.body.innerHTML = Result(0).innerHTML
            str = Html2.getElementsByTagName("a")(0).getAttribute("href")
            str = Replace(str, "about:/", "/")  'about: 삭제
            sht.Hyperlinks.Add anchor:=Rng, _
                                    Address:="https://endic.naver.com" & str, _
                                    ScreenTip:="단어검색(외부브라우저)"
            Rng.Font.Underline = xlUnderlineStyleNone
            Rng.Font.Color = rgbDarkBlue
            Rng.Font.Bold = True
        End If
        
        '발음파일
        Set Result = Html.getElementsByClassName("btn_side_play _soundPlay")
        If Result.Length Then
            TargetUrl = Result(0).getAttribute("playlist")
            LocalFile = ActiveWorkbook.Path & "\Mp3\" & Rng.Value & ".mp3"
            'DownloadFile TargetUrl, LocalFile
            URLDownloadToFile 0, TargetUrl, LocalFile, 0, 0
            
            '발음기호
            Rng.Offset(, 1).Value = Html.getElementsByClassName("fnt_e25")(0).innerText
            '발음파일에 하이퍼링크 추가
            sht.Hyperlinks.Add anchor:=Rng.Offset(, 1), _
                                     Address:=LocalFile, _
                                     SubAddress:=Rng.Offset(, 1).Address, _
                                     ScreenTip:=LocalFile
            Rng.Offset(, 1).Font.Underline = xlUnderlineStyleNone
            'Rng.Offset(, 1).Font.Color = rgbBlack
            
            '뜻
            Rng.Offset(, 2).Value = Html.getElementsByClassName("fnt_k05")(0).innerText
            
            '예문
            Rng.Offset(, 3).IndentLevel = 1
            Rng.Offset(, 3).Value = Html.getElementsByClassName("fnt_e07")(0).innerText
            Rng.Offset(, 3).ShrinkToFit = True  '셀크기에 맞게 글자 줄이기
            
            '예문해석
            Rng.Offset(, 4).IndentLevel = 1
            Rng.Offset(, 4).Value = Html.getElementsByClassName("fnt_k10")(0).innerText
            Rng.Offset(, 4).ShrinkToFit = True
            
        End If
        
        UserForm1.Caption = "Processing " & i & "/ " & (LastRow - 1) & "..."
        UserForm1.ProgressBar1.Value = CInt(i * 100 / (LastRow - 1))
        
    Next Rng
    
    Set Html2 = Nothing
    Set Html = Nothing
    Set XMLhttp = Nothing
    
    Unload UserForm1
    'Application.ScreenUpdating = True
 
End Sub
 
'mp3파일로 하이퍼링크할 때 뜨는 경고 메시지 제거
Sub KillHyperlinkWarning()
    Dim oShell As Object
    Dim strReg As String
 
    strReg = "Software\Microsoft\Office\11.0\Common\Security\DisableHyperlinkWarning"
 
    Set oShell = CreateObject("Wscript.Shell")
    oShell.RegWrite "HKCU\" & strReg, 1, "REG_DWORD"
End Sub
 

 

 

 

현재 EarlyBinding 을 이용해서 VBE창(Alt-F11)에서 도구-참조에
HTML Object Library 와 MSXML 6.0 등에 대한 외부 참조에 대한 체크가 되어 있어야 작동합니다.

첨부파일만 받아서 테스트할 경우 해당 PC에 관련 DLL이 있다면 바로 실행하면 됩니다.

LateBinding 을 이용해 변수들을 Object로 바꾸고 

CreateObject를 이용할 경우 GetElementsBy ~ 함수가 지원되지 않아 소스 수정이 필요합니다.

오피스 2010과 2016에서 테스트 되었습니다.

 

파일 다운로드:(기본연결프로그램으로 Mp3 재생)

네이버_단어발음HyperLink.xlsm

다운로드

 

 

 

추가:

하이퍼링크로 열릴 때 경고가 뜨고 외부 프로그램으로 mp3를 재생하는 딜레이를 없앤 버전입니다.

Hyper링크를 감지해서 MCISendString API를 이용해서 윈도우내장 미디어플레이어를 이용해 빠르게 mp3를 재생합니다.

레지스트리를 수정할 필요도 없습니다.

 

 

Option Explicit
 
Declare PtrSafe Function URLDownloadToFile Lib "urlmon" Alias "URLDownloadToFileA" _
    (ByVal pCaller As Long, ByVal szURL As String, ByVal szFileName As String, _
    ByVal dwReserved As Long, ByVal lpfnCB As Long) As Long
 
Declare PtrSafe Function ShellExecute Lib "shell32.dll" Alias "ShellExecuteA" _
    (ByVal hwnd As Long, ByVal lpszOp As String, _
     ByVal lpszFile As String, ByVal lpszParams As String, _
     ByVal LpszDir As String, ByVal FsShowCmd As Long) _
     As Long
 
Declare PtrSafe Function MCISendString Lib "winmm.dll" Alias _
   "mciSendStringA" (ByVal lpstrCommand As String, ByVal _
   lpstrReturnString As Any, ByVal uReturnLength As Long, ByVal _
   hwndCallback As Long) As Long
   
Public MCIPlay As Long
 
Sub GetWordList()
 
    Dim sht As Worksheet
    Dim i As Long
    Dim LastRow As Long
    Dim Rng As Range
    
    Dim XMLhttp As ServerXMLHTTP  'WinHttpRequest
    Dim Html As HTMLDocument, Html2 As HTMLDocument
    Dim Result As IHTMLElementCollection
    Dim Url As String, str As String
    Dim wordlist As Object
    Dim TargetUrl As String, LocalFile As String
    
    On Error Resume Next
    Set XMLhttp = New ServerXMLHTTP ' WinHttpRequest
    Set Html = New HTMLDocument
    Set Html2 = New HTMLDocument
        
    Set sht = ActiveSheet
    sht.Hyperlinks.Delete
    
    UserForm1.Show vbModeless   'progress bar
    'Application.ScreenUpdating = False
    
    LastRow = sht.Cells(sht.Rows.Count, 2).End(xlUp).Row
    
    For Each Rng In sht.Range("B2:B" & LastRow)
        str = vbNullString
        Url = "https://endic.naver.com/search.nhn?sLn=kr&query=" & Rng.Value
    
        With XMLhttp
            .Open "Get", Url
            .setRequestHeader "User-Agent", "Mobile"
            .send
            .WaitForResponse
            Html.body.innerHTML = .responseText
        End With
        
        '인덱스
        i = i + 1
        Rng.Offset(, -1).Value = i
        
        '단어에 웹링크
        Set Result = Html.getElementsByClassName("fnt_e30")
        If Result.Length Then
            'str = Html.getElementsByClassName("N=a:wrd.entry")(0).getAttribute("href")
            Html2.body.innerHTML = Result(0).innerHTML
            str = Html2.getElementsByTagName("a")(0).getAttribute("href")
            str = Replace(str, "about:/", "/")  'about: 삭제
            sht.Hyperlinks.Add anchor:=Rng, _
                                    Address:="https://endic.naver.com" & str, _
                                    ScreenTip:="단어검색(외부브라우저)"
            Rng.Font.Underline = xlUnderlineStyleNone
            Rng.Font.Color = rgbDarkBlue
            Rng.Font.Bold = True
        End If
        
        '발음파일
        Set Result = Html.getElementsByClassName("btn_side_play _soundPlay")
        If Result.Length Then
            TargetUrl = Result(0).getAttribute("playlist")
            LocalFile = ActiveWorkbook.Path & "\Mp3\" & Rng.Value & ".mp3"
            'DownloadFile TargetUrl, LocalFile
            URLDownloadToFile 0, TargetUrl, LocalFile, 0, 0
            
            '발음기호
            Rng.Offset(, 1).Value = Html.getElementsByClassName("fnt_e25")(0).innerText
            '발음파일에 하이퍼링크 추가
            sht.Hyperlinks.Add anchor:=Rng.Offset(, 1), _
                                     Address:="", _
                                     SubAddress:=Rng.Offset(, 1).Address, _
                                    ScreenTip:=LocalFile
            Rng.Offset(, 1).Font.Underline = xlUnderlineStyleNone
            'Rng.Offset(, 1).Font.Color = rgbBlack
            
            '뜻
            Rng.Offset(, 2).Value = Html.getElementsByClassName("fnt_k05")(0).innerText
            
            '예문
            Rng.Offset(, 3).IndentLevel = 1
            Rng.Offset(, 3).Value = Html.getElementsByClassName("fnt_e07")(0).innerText
            Rng.Offset(, 3).ShrinkToFit = True  '셀크기에 맞게 글자 줄이기
            
            '예문해석
            Rng.Offset(, 4).IndentLevel = 1
            Rng.Offset(, 4).Value = Html.getElementsByClassName("fnt_k10")(0).innerText
            Rng.Offset(, 4).ShrinkToFit = True
            
        End If
        
        UserForm1.Caption = "Processing " & i & "/ " & (LastRow - 1) & "..."
        UserForm1.ProgressBar1.Value = CInt(i * 100 / (LastRow - 1))
        
    Next Rng
    
    Set Html2 = Nothing
    Set Html = Nothing
    Set XMLhttp = Nothing
    
    Unload UserForm1
    'Application.ScreenUpdating = True
 
End Sub
 
Sub DownloadFile(myURL As String, saveFILE As String)
 
    'myURL = "https://YourWebSite.com/?your_query_parameters"
    'saveFILE = "C:\file.csv"
    Dim WinHttpReq As Object
    Set WinHttpReq = CreateObject("Microsoft.XMLHTTP")
    WinHttpReq.Open "GET", myURL, False, "username", "password"
    WinHttpReq.send
    
    myURL = WinHttpReq.responseBody
    If WinHttpReq.Status = 200 Then
        Dim oStream As Object
        Set oStream = CreateObject("ADODB.Stream")
        oStream.Open
        oStream.Type = 1
        oStream.Write WinHttpReq.responseBody
        oStream.SaveToFile saveFILE, 2 ' 1 = no overwrite, 2 = overwrite
        oStream.Close
    End If
 
End Sub
 
Sub URLDownload(myURL As String, DownloadFile As String)
    Dim LocalFilename$
    
    'DownloadFile$ = "someFile.ext" 'here the name with extension
    'Url$ = "http://some.web.address/" & DownloadFile 'Here is the web address
    LocalFilename$ = "C:\Some\Path" & DownloadFile
    'here the drive and download directory
    MsgBox "Download Status : " & URLDownloadToFile(0, myURL, LocalFilename, 0, 0) = 0
End Sub
 
Function killHyperlinkWarning()
    Dim oShell As Object
    Dim strReg As String
 
    strReg = "Software\Microsoft\Office\11.0\Common\Security\DisableHyperlinkWarning"
 
    Set oShell = CreateObject("Wscript.Shell")
    oShell.RegWrite "HKCU\" & strReg, 1, "REG_DWORD"
End Function
 
Public Sub ShellEx(ByVal Path As String, Optional ByVal Parameters As String, Optional ByVal HideWindow As Boolean)
 
    If Dir(Path) > "" Then
        ShellExecute 0, "open", Path, Parameters, "", IIf(HideWindow, 0, 1)
    End If
 
End Sub
 
Sub MCIAudioPlay(TargetFile As String)
   
    'If MusicOff Then Exit Sub
    'TargetFile should not include any space like "program files\~"
    'send the audio start signal
    MCIPlay = MCISendString("close myAudio", Nothing, 0, 0)
    'MCIPlay = mciSendString("play " & Track, 0&, 0, 0)
    MCIPlay = MCISendString("open " & Chr$(34) & TargetFile & Chr$(34) & " alias myAudio wait", Nothing, 0, 0)
    MCIPlay = MCISendString("play myAudio", Nothing, 0, 0)  ' repeat
    MCIPlay = MCISendString("setaudio myWAudio volume to 150", Nothing, 0, 0)
    
End Sub
 
Sub MCIAudioStop()
    If MCIPlay Then MCIPlay = MCISendString("stop myAudio", Nothing, 0, 0)
End Sub
 
 

 

추가 파일 다운로드: (윈도우내장미디어플레이어이용 버전)

네이버_단어발음파일.xlsm

다운로드

 

Mp3파일이 많아지면 한폴더에 너무 많은 파일이 있게되어 알파벳 첫글자 폴더를 자동 생성하여 저장하는 버전

네이버_단어발음파일_Alpha.xlsm

다운로드

(아래 Beta버전으로 받으시는 걸 추천합니다.)

 

 

라이브러리 오류가 나온다는 피드백이 있어서 라이브러리를 최소화하고 Late Binding으로 수정한 버전입니다.

Progress바도 없애고 아래 상태표시줄에 진행률 퍼센트가 표시됩니다.

Microsft HTML Object Library만을 [도구-참조]에서 체크하면 됩니다. ( mshtml 은 대부분 시스템에 깔려 있습니다.)

네이버_단어발음파일_Beta.xlsm

다운로드

 

 

 

속도때문에 단어 발음기호와 뜻만 검색을 원하시는 분이 있어 심플버전을 첨부합니다.

악성코드로 오진되어 압축파일로 첨부합니다. (암호는 konahn 입니다.)

[2022.04.29] 아래는 현재 수정본입니다. ** 아래 파일이 영어 단어, 발음, 뜻만 검색하는 가장 최신 심플버전입니다. **

네이버사전검색New1.zip

0.09MB

 

요청에 의해 일본어 검색 및 발음 다운로드 샘플을 추가합니다. 

MP3JPN 폴더에 첫번째 여성 발음을 다운받습니다.

악성코드로 오진되어 압축파일로 첨부합니다. (암호는 konahn 입니다.)

[2022.04.24] 사이트 내부처리방식 변동으로 인해 Json데이터방식으로 변경

네이버_단어발음파일_Json_일본어.zip

0.08MB

[2022.09.21] 접속시 JSON데이터 대신 빈 데이터가 받아지는 오류가 발생하여  Http접속시 referer 를 추가하고 WinHttpRequest.5.1 로 접속하도록 수정한 버전.(암호는 konahn) 

네이버_단어발음파일_Json_일본어1.zip

0.08MB

 

 

[2019.11.27] 중국어 검색 버전

MP3CHN 폴더에 mp3저장, JSON데이터검색, TTS 발음은 미지원.

네이버사전검색New_중국어.xlsm

다운로드

악성코드로 오진되어 압축파일로 첨부합니다. (암호는 konahn 입니다.)

네이버사전검색New_중국어.zip

다운로드

 

 

 

 

[2019.12.03. 추가]

Oxford 영영사전 검색 - 마우스 오른쪽 메뉴에 명령어 추가함. 순서대로 윈10용, 윈10용 단순버전, 윈7용 단순버전.

[2021.05.14. 수정]

class이름 수정, 모두 Late Binding으로 수정

 

Oxford1.xlsm

0.06MB

Oxford2.xlsm

0.02MB

Oxford2-1.xlsm

0.02MB

 

[2022.11.28 임시 작동 버전]

Oxford2-2.xlsm

0.03MB

 

 

 

엑셀2010의 경우 아래 화면과 같이 체크되어 있으면 되고

엑셀2016의 경우 Excel과 Office 버전만 16.0 에 체크되면 됩니다.

 

 

 

주의사항:

 

Early Binding(미리 외부개체를 선언하는 방식) 이라 Alt-F11 편집창에서

아래와 같이 도구-참조에서 해당 라이브러리가 체크되어 있어야 합니다.

특히 Microsoft HTML Object Library,

Microsoft XML 6.0 이나 하위버전,

Microsoft Forms 2.0 Object Library,

Microsoft Windows Common Controls 6.0 등의 라이브러리가 체크되어 있어야 합니다.

현재 첨부파일은 체크되어 있으나 

사용자의 시스템에 없는 라이브러리는 컴파일 오류가 발생합니다.

XML 6.0이 없다면 XML 5.0 같은 하위버전이라도 체크가 되어 있어야 합니다.

 

 

 

 

 

 

[저작권주의]

 

단어 검색 컨텐츠 및 mp3는 해당 저작권자에게 있습니다.

이 매크로는 VBA로 웹자료를 가져오는 방법에 대한 공부와 교육적 차원에서 공유하는 것입니다.