[vb6.0/vba] 웹브라우져(InternetExplorer)를 이용한 다음 지도검색 > vb6.0/vba

본문 바로가기

vb6.0/vba

[vb6.0/vba] [vb6.0/vba] 웹브라우져(InternetExplorer)를 이용한 다음 지도검색

회원사진
하나를하더라도최선을
2020-03-16 21:55 4,558 0

본문




아래처럼 인터넷 익스플로워가 있으면 새로 열지 않고 기존에 열려있는 창에서 검색을 합니다.
열려있는 창이 없으면 새로운 인터넷 창을 열어 작업합니다.
 90af3357462783fa6f826b97a93f7a6d_1584363285_1057.png

 
 
 
 
Option Explicit
 
 
Private Declare Function WideCharToMultiByte Lib "kernel32" ( _
     ByVal codepage As Long, _
     ByVal dwFlags As Long, _
     ByVal lpWideCharStr As Long, _
     ByVal cchWideChar As Long, _
     ByVal lpMultiByteStr As Long, _
     ByVal cchMultiByte As Long, _
     ByVal lpDefaultChar As Long, _
     ByVal lpUsedDefaultChar As Long _
As Long
 
Private Const CP_UTF8 As Long = 65001
 
Sub test()
    Dim O As Object
    Set O = FindIE
    If O Is Nothing Then Set O = CreateObject("InternetExplorer.Application")
O.Visible = True
    O.Navigate2 "http://map.daum.net/?q=" + UTF8("롯데호텔"'// 검색할 검색어
End Sub
 
Function FindIE() As Object'// 열려있는 익스플로워를 찿음
    Dim IE As Object
    For Each IE In CreateObject("Shell.Application").Windows
        If TypeName(IE.Document) = "HTMLDocument" Then
            Set FindIE = IE
        End If
    Next
End Function
 
'### 한글 -> UTF-8(인코딩)
Public Function UTF8(ByRef T) As String
On Error GoTo ErrLbl
    Dim str As String
    str = T
'    str = Replace$(str, "<", "&lt;")
'    str = Replace$(str, ">", "&gt;")
     Dim BufSize As Long, MultiArr() As Byte, Buf As String, i As Long
     Dim UniArr() As Byte
     UniArr = str
     BufSize = WideCharToMultiByte(CP_UTF8, 0&, VarPtr(UniArr(0)), (UBound(UniArr) + 1/ 20&0&0&0&)
     If BufSize > 0 Then
          ReDim MultiArr(BufSize - 1&)
          WideCharToMultiByte CP_UTF8, 0&, VarPtr(UniArr(0)), (UBound(UniArr) + 1/ 2, VarPtr(MultiArr(0)), BufSize, 0&0&
     End If
     For i = 0 To UBound(MultiArr)
        If MultiArr(i) = 63 Then
            Buf = Buf & Chr(MultiArr(i)) '// ?
        Else
            Select Case Chr(MultiArr(i))
                Case " ": Buf = Buf & "+"
                Case vbNewLine, vbCrLf, vbLf, vbCr: Buf = Buf & "%0A"
                Case "*""-""_""."":""="
                    Buf = Buf & Chr(MultiArr(i)) '// 특문
                Case 0 To 9
                    Buf = Buf & Chr(MultiArr(i)) '// 숫자
                Case "A" To "Z"
                    Buf = Buf & Chr(MultiArr(i)) '// 영대
                Case "a" To "z"
                    Buf = Buf & Chr(MultiArr(i))    '// 영소
                Case Else
                    Buf = Buf & "%" & IIf(Len(Hex$(MultiArr(i))) Mod 20""& Hex$(MultiArr(i))
            End Select
        End If
     Next i
     UTF8 = Buf
ErrLbl:
End Function
 
 
 

댓글목록0

등록된 댓글이 없습니다.
게시판 전체검색