vb6.0/vba [vb6.0/vba] 웹브라우져(InternetExplorer)를 이용한 다음 지도검색
페이지 정보
본문
아래처럼 인터넷 익스플로워가 있으면 새로 열지 않고 기존에 열려있는 창에서 검색을 합니다.
열려있는 창이 없으면 새로운 인터넷 창을 열어 작업합니다.
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
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, "<", "<")
' str = Replace$(str, ">", ">")
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) / 2, 0&, 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 2, 0, "") & Hex$(MultiArr(i))
End Select
End If
Next i
UTF8 = Buf
ErrLbl:
End Function
- 이전글[vb6.0/vba] vba 바탕화면의 특정폴더에 파일 다운로드 20.03.16
- 다음글[vb6.0/vba] 인터넷익스플로워 띄우기 및 검색하기/FindIE 20.03.16
댓글목록
등록된 댓글이 없습니다.