XLS+VBA

WordReference.com 사전 단어 자동 검색 및 MP3다운로드

쵸코난 2019. 12. 24. 16:25

https://www.wordreference.com/enko/

 

WordReference 영-한 사전

한-영 사전 WordReference 영-한 사전은 특별히 온라인 세상에 맞도록 적용된 사전입니다. 본 사전의 특징은: 간단하며 읽기 쉬운 포맷으로 되어 있습니다. 질문이 있는 경우 종합토론장에 올리실수 있습니다. 지속적으로 진전이 이루어지고 있습니다. 저작권 © WordReference.com LLC 2019 대규모의 사전 엔트리 복사는 법적으로 금지되어 있습니다. Sitemap

www.wordreference.com

현재 워크시트의 단어(들)에 대해 위 사이트에 접속해서 아래와 같이

영어단어의 뜻, 발음기호, 발음MP3, 예문, 동의어를 자동으로 가져옵니다.

 

원래 http://kimstar.kr/7445/ 의 엑셀을 바탕으로

https://www.gohackers.com/?c=toefl/toefl_info/toefldata&uid=418682 이분이 수정을 하셨는데

몇가지 부분이 안되는 부분이 있다는 질문( https://kin.naver.com/qna/detail.nhn?d1id=1&dirId=102020101&docId=343036767&clubid=16854404&menuid=248&dirId=102020103 )에

제가 제 방식대로 만들어 본 것입니다.

 

특징은,

1. 기존 방식은 서버에 xmlhttp 로 접속해서 html 을 정규식을 이용해서 파싱하는데

제 방식은 서버에 ServerXmlHttp 로 접속해서 Html Object Library 를 이용해서 파싱합니다.

 

2. 아래와 같은 인터페이스와 기능을 제공합니다.

- 'WordRef' 라는 추가기능 탭이 생겨나서 메뉴 호출이 간편합니다.

- 마우스 우클릭 메뉴에 자주 쓰는 3가지 기능을 추가해서 어느 셀에서나 기능 호출이 가능합니다.

 

 

제공하는 기능을 좀 더 자세히 살펴보겠습니다.

 

1. 첫번째 WordReference.com 사전 검색기능입니다.

아래와 같이 작은 돋보기 그림, 혹은 리본메뉴, 마우스 우클릭으로  검색이 가능합니다.

현재 선택된 행의 단어를 검색하는 것이 기본이고

쉬프트 키나 컨트롤키를 누른 채 여러 셀을 다중 선택해서 검색할 수도 있습니다.

Search All 을 실행하면 시간이 오래 걸리기 때문에 한번 경고가 뜹니다.

 

 

파싱하는데 있어서 WordReference.com 은 HTML이 Class 이름을 적극적으로 사용하지 않아

HTML을 파싱하는데 어려움이 많았습니다.

TD, TR 태그를 찾거나 InStr, Left, Mid 등을 이용해야 했습니다.

그래서 사이트의 HTML구조가 달라지면 작동하지 않을 가능성이 높습니다.

 

2. 발음 MP3 다운로드 및 플레이 기능입니다.

일단, B열의 단어를 클릭하면 wordReference 사이트를 방문하고

C열의 발음기호를 클릭하면 위 사이트의 발음으로 연결되어 브라우저에서 소리를 재생합니다.

 

현재 행이나 여러 행을 선택한 채로

리본메뉴의 버튼이나 마우스 우클릭으로

MP3파일을 다운로드하거나 현재 행의 단어에 해당하는 MP3폴더의 로컬MP3를 재생합니다.

 

 

MP3의 다운 경로는 기본적으로 현재 xlsm 파일의 하위 MP3폴더에

해당 단어의 첫글자 알파벳 폴더에 저장합니다.

만일 apple.mp3 라면 MP3\a\apple.mp3 가 됩니다.

 

 

3.  아래와 같이 다른 여러사이트에서 해당단어의 검색을 지원합니다.

 "영한사전:"  https://www.wordreference.com/enko/
 "영영사전:"  https://www.wordreference.com/definition/  
  "Webster": "https://www.merriam-webster.com/dictionary/"
 "Dictionary": "https://www.dictionary.com/browse/"
 "Oxford": "https://www.oxfordlearnersdictionaries.com/definition/english/"
 "Naver": "https://en.dict.naver.com/#/search?range=all&query="
 "Daum": "https://dic.daum.net/search.do?q="
 "구글":  https://www.google.com/search?q="

 

 

4. 예문에 번역이 있는 경우 메모창에 해석을 보여줍니다.

 

 

VBA매크로가 작동하기 위해서는 매크로가 허용되어야 하고

반드시 Alt-F11 창에서 도구-참조에서 'Microsoft HTML Object Library"가 체크되어 있어야 합니다.

또한 시스템에 XML 6.0(ServerXMLHttp 접속), UrlMon.dll(파일 다운로드), Shell32.dll(외부 실행), WinMM.dll (Sound 재생)등의 DLL 라이브러리 파일이 존재하고 시스템에 등록되어 있어야 합니다.

 

첨부파일을 티스토리에서 유해코드로 오진을 하기 때문에 파일을 압축해서 올립니다.

(소스는 공개되어 있으므로 유해코드가 있는지 확인 가능합니다.)

압축비번은 konahn 입니다. 

 

WordReference2_konahn.zip
0.24MB

- 댓글 주셔서 동의어 부분 살짝 수정했습니다. 감사합니다. (2021.09.02.)

- 일부 시스템에서 불러온 HTML의 대소문자나 따옴표 등의 이유로 검색이 안되는 증상을 수정하였습니다. (2021.09.07.)

  대소문자를 무시하도록 Option Compare Text 를 추가했고

  Split 처리시에서 따옴표가 있을 경우 오류가 나는 것을 방지했습니다.

  그리고 일단 오류가 생기면 어디서 나는지 알 수 있게 On error resume next 주석 해제한 상태입니다.

 

Module1 소스 보기:

더보기
'// At [Tools - Reference], add reference to 'Microsoft Html Object Library'
'//
'// Web(WordReference.Com) Crawling Example
'// by konahn(at)naver.com

Option Explicit
Option Compare Text

Const BaseUrl As String = "https://www.wordreference.com/"

Sub onLoad(control As IRibbonUI)
    control.ActivateTab "Tab1"
    Application.SendKeys "%Y%" 'Alt + Y + Alt
    Sheets(1).Activate
End Sub

Sub SearchSelected(control As IRibbonControl)
     SearchSelectedWord control 'to call sub routine, control parameter should be passed.
End Sub

Sub SearchAll(control As IRibbonControl)
    SearchAllWords control
End Sub

Sub SearchInfo(control As IRibbonControl)
    MsgBox "Search Words in WordReference.Com" & vbNewLine & vbNewLine & _
        "by konahn(at)naver.com", vbInformation
End Sub

Public Sub SearchOnline(control As IRibbonControl)
    Dim url As String
    Dim strCmd As String
    'Dim cmd As String
    
    'cmd = "C:\Program Files (x86)\Google\Chrome\Application\Chrome.exe"  '64비트
    'cmd ="C:\Program Files\Google\Chrome\Application\Chrome.exe"    '32비트
    'cmd = "C:\Windows\Explorer.exe "
    
    Select Case control.Tag
    Case "WordRef(ko)":
        url = BaseUrl & "enko/"
    Case "WordRef(en)":
        url = BaseUrl & "definition/"
    Case "Webster":
        url = "https://www.merriam-webster.com/dictionary/"
    Case "Dictionary":
        url = "https://www.dictionary.com/browse/"
    Case "Oxford":
        url = "https://www.oxfordlearnersdictionaries.com/definition/english/"
    Case "Naver":
        url = "https://en.dict.naver.com/#/search?range=all&query="
    Case "Daum":
        url = "https://dic.daum.net/search.do?q="
    Case Else:
        url = "https://www.google.com/search?q="
    End Select
    
    '현재 행의 단어를 인수로 넘겨서 기본 브라우져 실행
    'strcmd =cmd & Chr(34) & url & Range("B" & ActiveCell.Row) & Chr(34))
    'Call Shell(strCmd)
    strCmd = url & Range("B" & ActiveCell.Row)
    ShellExecute 0, "open", strCmd, "", "", 1
    
End Sub

Sub SearchOnlineWordRef()
    ShellExecute 0, "open", BaseUrl & "enko/" & Range("B" & ActiveCell.Row), "", "", 1
End Sub

Sub SearchAllWords(Optional ctl As IRibbonControl)

    Dim Sht As Worksheet
    Dim wordRng As Range
    Dim i As Long
    Dim LastRow As Long
    
    If MsgBox("모든 단어검색은 시간이 오래 걸립니다." & vbNewLine & vbNewLine _
        & "원하는 단어들만 다중 선택해서 검색하는 것을 추천합니다." & vbNewLine & vbNewLine _
        & "그래도 모든 단어 검색을 계속할까요?", vbOKCancel) = vbCancel _
        Then Exit Sub
    
    'Application.ScreenUpdating = False
    Set Sht = ActiveSheet
    Sht.Hyperlinks.Delete
        
    LastRow = Sht.Cells(Sht.Rows.Count, 2).End(xlUp).Row
    If LastRow < 2 Then Exit Sub
    
    For Each wordRng In Sht.Range("B2:B" & LastRow)
        '인덱스
        i = i + 1
        
        '단어 검색
        SearchWord wordRng
        
        '진행률 상태바에 표시
        Application.StatusBar = "(" & i & "/ " & (LastRow - 2) & ") " & _
                                CInt(i * 100 / (LastRow - 2)) & " %"
    Next wordRng
    
    Application.StatusBar = False
    'Application.ScreenUpdating = True
End Sub

Sub SearchSelectedWord(Optional ctl As IRibbonControl)

    Dim selRng As Range, wordRng As Range
    Dim i As Long
    
    For Each selRng In ActiveWindow.Selection.Areas '다중 선택 고려
        Set selRng = selRng.Resize(, 1)  '1열만 선택
        Set selRng = Range("B" & selRng(1).Row & ":B" & selRng(selRng.Count).Row)
  
        For Each wordRng In selRng
            '인덱스
            i = i + 1
            
            '단어 검색
            SearchWord wordRng
            
            '진행률 상태바에 표시
            Application.StatusBar = "Searching (" & i & "/ " & selRng.Rows.Count & ") " & _
                                    CInt(i * 100 / (selRng.Rows.Count - 2)) & " % ..."
        Next wordRng
        Application.StatusBar = False
        
    Next selRng
    
End Sub

'Sub SearchActiveWord()
'    Dim rRng As Range
'
'    Set rRng = Range("B" & ActiveCell.Row)
'    If Len(rRng) Then SearchWord rRng
'End Sub

Function SearchWord(Rng As Range)

    Dim XMLhttp As Object   'MSXML2.ServerXMLHTTP60  'WinHttpRequest
    Dim Html As MSHTML.HTMLDocument
    Dim Html1 As MSHTML.HTMLDocument
    
    Dim oSht As Worksheet
    Dim url As String
    Dim childObj As MSHTML.IHTMLElement
    Dim temp As String, tmp As String, temp0 As String
    
    Set XMLhttp = CreateObject("MSXML2.ServerXMLHTTP")
    'Set XMLhttp = New MSXML2.ServerXMLHTTP60 ' WinHttpRequest
    Set Html = New MSHTML.HTMLDocument
    Set Html1 = New MSHTML.HTMLDocument

    'On Error Resume Next
    Set oSht = ActiveSheet
    Rng.Select
    url = BaseUrl & "enko/" & Rng.Text

    With XMLhttp
        .Open "Get", url, True
        '.setRequestHeader "User-Agent", "Mozilla"
        .send
        While .readyState <> 4: .waitForResponse 100: Wend
        Html.body.innerHTML = .responseText
    End With
    
    '기존 내용 삭제
    Rng.Offset(, 1).Resize(1, 4).ClearContents
    Rng.Offset(, 1).Resize(1, 4).ClearComments
    
    '단어에 웹링크
    oSht.Hyperlinks.Add anchor:=Rng, Address:=url, ScreenTip:="[웹브라우저 연결]"
    Rng.Font.Underline = xlUnderlineStyleNone
    Rng.Font.Color = rgbDarkBlue
    Rng.Font.Bold = True
    Rng.Font.Size = 9
    
    '발음기호
    If Html.getElementsByClassName("pronRH").Length Then
        temp = Html.getElementsByClassName("pronRH")(0).innerText
        temp = Replace(temp, "USA pronuncation: IPA", "")
        temp = Replace(temp, "USA pronunciation: respelling", "")
        Rng.Offset(, 1) = temp
        If Html.getElementsByTagName("source").Length Then _
            oSht.Hyperlinks.Add anchor:=Rng.Offset(, 1), _
                Address:=BaseUrl & Html.getElementsByTagName("source")(0).src, _
                ScreenTip:="[발음파일 연결]"
        Rng.Offset(, 1).Font.Underline = xlUnderlineStyleNone
        Rng.Offset(, 1).Font.Color = rgbBlack
        Rng.Offset(, 1).Font.Name = "Calibri"
        Rng.Offset(, 1).Font.Size = 9
    
        '발음파일에 하이퍼링크 추가
        'osht.Hyperlinks.Add anchor:=Rng.Offset(, 1), Address:="", SubAddress:=Rng.Offset(, 1).Address, ScreenTip:=LocalFile
    End If
    
    '동의어
    If Html.getElementsByClassName("extras even").Length Then
        temp = Html.getElementsByClassName("extras even")(0).getElementsByTagName("div")(0).innerText
        If InStr(temp, "검색어 포함 목록: ") > 0 Then
            temp = Html.getElementsByClassName("extras even")(0).getElementsByTagName("div")(1).innerText
        End If
        temp = Replace(temp, "동의어: ", "")
        temp = Replace(temp, " 더 보기…", "")
        If Right(temp, 1) = "," Then temp = Left(temp, Len(temp) - 1)
        Rng.Offset(, 4) = temp
    End If

    Debug.Print Html.getElementsByClassName("WRD")(0).innerHTML
    
    '뜻
    '단어의 tbody 부분만 추출
    temp = Html.getElementsByClassName("WRD")(0).innerHTML
    Html.body.innerHTML = "<Table>" & temp & "</Table>"
    temp = Html.getElementsByTagName("tbody")(0).innerHTML
    Html.body.innerHTML = "<Table>" & temp & "</Table>"
    '단어 부분 Table만 추출하고 다시 그 안의 첫번째 <tr class='wrtopsection'> 부분만 추출
    'temp = Split(Html.getElementsByClassName("WRD")(0).innerHTML, "<tr class=wrtopsection>")(1)
    'Html.body.innerHTML = "<Table><tr class='wrtopsection'>" & temp & "</Table>"
    'Debug.Print Html.body.innerHTML
    
    For Each childObj In Html.getElementsByTagName("Tr")

        '뜻만 가져오기
        tmp = "": temp = "": temp0 = ""
        If childObj.ID Like "enko:*" Then
            Html1.body.innerHTML = "<Table>" & childObj.outerHTML & "</Table>"
            temp0 = Html1.getElementsByTagName("td")(1).innerText   '영어 뜻
            
            temp = Html1.getElementsByTagName("td")(2).innerHTML
            temp = removeTags(Left(temp, InStr(temp, " <EM") - 1)) '뜻만
            temp = Replace(temp, "번역할 수 없음", "")
            
            '품사 가져오기
            tmp = Html1.getElementsByTagName("td")(2).innerHTML '예) 새김눈을 내다 <em class='POS2'>동(타)</em>
            tmp = Mid(tmp, InStr(tmp, ">") + 1)
            tmp = Left(tmp, InStr(tmp, "<") - 1)
            tmp = Replace(tmp, " ", "")
            If Len(tmp) Then tmp = "[" & tmp & "]"
            If Len(temp) Then Rng.Offset(, 2) = Rng.Offset(, 2) & vbNewLine & tmp & temp0 & temp
        End If
    Next childObj
    Rng.Offset(, 2) = Mid(Rng.Offset(, 2), Len(vbNewLine) + 1)
    Rng.Offset(, 2).Font.Name = "맑은 고딕"
    
    '예문
    For Each childObj In Html.getElementsByClassName("FrEx")
        Rng.Offset(, 3) = Rng.Offset(, 3) & vbNewLine & childObj.innerText
    Next childObj
    Rng.Offset(, 3) = Mid(Rng.Offset(, 3), Len(vbNewLine) + 1)
    '예문 밑줄 추가
    Dim t As Integer
    t = 1
    Do While t < Len(Rng.Offset(, 3))
        t = InStr(t, Rng.Offset(, 3), Rng)
        If t = 0 Then Exit Do
        Rng.Offset(, 3).Characters(t, Len(Rng)).Font.Underline = True
        t = t + Len(Rng)
    Loop
    '예문 뜻
    temp = "": t = 0
    For Each childObj In Html.getElementsByClassName("ToEx")
        If Len(childObj.innerText) Then
            t = t + 1
            If t = 1 Then temp = childObj.innerText _
                Else temp = temp & vbNewLine & childObj.innerText
        End If
    Next childObj
    If Len(temp) Then
        Dim cmt As Comment
        Set cmt = Rng.Offset(, 3).AddComment(temp)
        'cmt.Shape.TextFrame.AutoSize = True
        cmt.Shape.Width = 250
        cmt.Shape.Height = t * 30
    End If
    
    Set Html = Nothing
    Set XMLhttp = Nothing


End Function

'not used
Function removeTags(s As String) As String
    Dim ls As String
    removeTags = s
    If InStr(s, "<") > 0 Then
        ls = Left(s, InStr(s, "<") - 1)
        removeTags = ls & removeTags(Mid(s, InStr(Len(ls) + 1, s, ">") + 1))
    End If
End Function

 

Module2 소스보기

더보기
Option Explicit

#If VBA7 Then
    Declare PtrSafe Function URLDownloadToFile Lib "urlmon.dll" 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
#Else
    Declare Function URLDownloadToFile Lib "urlmon.dll" 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 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 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
#End If

Public MCIPlay As Long
Const Mp3AlPha As Boolean = True    ' True이면 알파벳별로 Mp3를 Mp3\a, Mp3\b, Mp3\c ...에 저장
Public Const MP3PATH = "Mp3"

Sub DownloadMP3(Optional ctl As IRibbonControl)

    Dim selRng As Range, wordRng As Range
    Dim i As Long
    
    i = 0
    For Each selRng In ActiveWindow.Selection.Areas '다중 선택 고려
        Set selRng = selRng.Resize(, 1)  '1열만 선택
        Set selRng = Range("B" & selRng(1).Row & ":B" & selRng(selRng.Count).Row)
  
        For Each wordRng In selRng
            
            '단어 검색
            i = i + IIf(DownloadRng(wordRng), 1, 0)
            
            '진행률 상태바에 표시
            Application.StatusBar = "Downloading MP3 (" & i & "/ " & selRng.Rows.Count & ") " & _
                                    CInt(i * 100 / (selRng.Rows.Count)) & " % ..."
        Next wordRng
        Application.StatusBar = False
        
    Next selRng
    
    Application.StatusBar = "Total '" & i & "' MP3 file(s) were downloaded."
    Application.OnTime Now + TimeSerial(0, 0, 5), "StatusBarOff"   '5초 후 메시지 지우기
    
End Sub

Function StatusBarOff()
    Application.StatusBar = False
End Function

Sub DownloadAndPlayMP3()
    DownloadMP3
    PlayMP3
End Sub

Function DownloadRng(Rng As Range) As Boolean

    Dim LocalPath As String
    Dim TargetUrl As String
    Dim Sht As Worksheet
    Dim hLnk As Hyperlink
    
    DownloadRng = False
    Set Sht = ActiveSheet
    'Set Rng = Sht.Range("B" & ActiveCell.Row)   '현재 단어셀
    
    '폴더가 없을 때 생성
    LocalPath = ThisWorkbook.Path & "\" & MP3PATH
    If Len(Dir(LocalPath, vbDirectory)) = 0 Then MkDir LocalPath
    
    '알파벳첫글자 폴더에 저장
    If Mp3AlPha Then
        LocalPath = LocalPath & "\" & Left(Rng.Text, 1)
        If Len(Dir(LocalPath, vbDirectory)) = 0 Then MkDir LocalPath
    End If
    

    TargetUrl = ""
    For Each hLnk In Sht.Hyperlinks
        If Rng.Offset(, 1) = hLnk.Range Then TargetUrl = hLnk.Address: Exit For
    Next hLnk
    
    If Len(TargetUrl) Then
        LocalPath = LocalPath & "\" & Rng.Text & ".mp3"
        'DownloadFile TargetUrl, LocalPath
        URLDownloadToFile 0, TargetUrl, LocalPath, 0, 0
        DownloadRng = True
    Else
        Debug.Print "Error: MP3 Hyperlink not found for '" & _
            Rng.Text & ".'", Rng.Address
    End If
    
End Function

Sub PlayMP3(Optional control As IRibbonControl)

    Dim LocalPath As String
    Dim Rng As Range
    
    Set Rng = Range("B" & ActiveCell.Row)    '현재 단어셀
        
    LocalPath = ThisWorkbook.Path & "\" & MP3PATH
    If Len(Dir(LocalPath, vbDirectory)) = 0 Then _
        MsgBox LocalPath & "가 존재하지 않습니다.", vbExclamation: Exit Sub
    
    '알파벳첫글자 폴더
    If Mp3AlPha Then
        LocalPath = LocalPath & "\" & Left(Rng.Text, 1)
        If Len(Dir(LocalPath, vbDirectory)) = 0 Then _
        MsgBox LocalPath & "가 존재하지 않습니다.", vbExclamation: Exit Sub
    End If
    
    LocalPath = LocalPath & "\" & Rng.Value & ".mp3"
    If Len(Dir(LocalPath)) Then
        MCIAudioPlay LocalPath
    Else
        MsgBox LocalPath & "가 존재하지 않습니다. 다운로드를 시도해보세요.", vbExclamation
    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("setaudio myWAudio volume to 150", Nothing, 0, 0)
    MCIPlay = MCISendString("play myAudio", Nothing, 0, 0)  ' repeat
End Sub

Sub MCIAudioStop()
    If MCIPlay Then
        MCIPlay = MCISendString("stop myAudio", Nothing, 0, 0)
        MCIPlay = MCISendString("close myAudio", Nothing, 0, 0)
    End If
End Sub

'//not used
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

'//not used
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

'//not used
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"
    Set oShell = Nothing
End Function

'// Not used
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

 

곁들여서 네이버 사전검색은 아래 글을 참고하세요.

https://konahn.tistory.com/entry/NaverDicAndMP3

 

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

단어 리스트에 대해 실시간으로 네이버사전을 검색해서 첫번째 뜻과 예문 등을 가져오고 또한 해당 단어 발음(첫번째 미국식)을 Mp3폴더에 자동으로 다운 받는 매크로입니다. 사용법: 첨부파일을 다운받고 매크로..

konahn.tistory.com