외한은행의 환율표를 긁어오는 VBA코드입니다.
요즘 DB의 과부하를 막기 위해 HTML소스를 암호화한다든가해서..
웹쿼리로 가져올 수 없는 부분에 대한 해결책이 될 수 있을 것 같습니다.
지금은 졸리니까..
내일부터 천천히 소스를 뒤집어봐야겠습니다. ^-^;;
지금은 잘 안되지만.. 소스를 분석해보는것만으로도 큰 도움이 될 것 같습니다...
그래서 일단 연구과제 카테고리에 남겨놨습니다. ^-^;;
관련 코드의 원천은 아래 사이트에 있다지요..
http://www.dailydoseofexcel.com/archives/2006/11/29/html-tables/
관련 파일 다운 받기 : 2009_1_24_web_page_data_control_Book3.xls
==============================================================================
내용추가 : 2011.12.04
VBA_웹페이지텍스트잘라오기_20100707-1.xls
'### ============================================================= ###
Option Explicit
Sub getXeMemberInfo()
Dim strURL As String
strURL = "http://abyul.com/"
getTextFromWeb (strURL)
End Sub
Sub getTextFromWeb(strURL As String)
Dim i As Integer
Application.ScreenUpdating = False
Application.Calculation = xlManual
Dim ie As Object, objDoc As Object
Set ie = CreateObject("internetexplorer.application")
ie.Navigate strURL
Do
If ie.ReadyState = 4 Then
ie.Visible = False
Exit Do
Else
DoEvents
End If
Loop
Set objDoc = ie.Document
Dim v As Variant
v = Split(objDoc.body.innertext, Chr(10))
Sheets.Add
For i = LBound(v) + 3 To UBound(v) - 1
ActiveCell.Offset(i).Value = v(i)
Next i
ie.Quit
Set objDoc = Nothing
Set ie = Nothing
Beep
Application.ScreenUpdating = True
Application.Calculation = xlAutomatic
End Sub
'### ============================================================= ###
'### From. http://kin.naver.com/qna/detail.nhn?d1id=1&dirId=10402&docId=64441065&qb=7JeR7IWAIOybuey/vOumrA==&enc=utf8§ion=kin&rank=22&search_sort=0&spq=0&sp=3&pid=gXkl4F5Y7ZlssZUXdXwssc--108648&sid=TubgItTB5k4AAEXuGY4
Private Sub Command1_Click()
Command1.Enabled = False
MousePointer = vbHourglass
DoEvents
Winsock1.RemoteHost = "sol-a.com"
Winsock1.RemotePort = 80
Winsock1.Connect
End Sub
Private Sub Winsock1_Close()
Command1.Enabled = True
MousePointer = vbDefault
End Sub
Private Sub Winsock1_Connect()
Dim Cmd$, URL$
URL = "http://www.sol-a.com/index.htm"
Cmd = "GET " & URL & " HTTP/1.0" & vbCrLf & "Accept: */*" & _
vbCrLf & "Accept: text/html" & vbCrLf & vbCrLf
Winsock1.SendData Cmd
End Sub
Private Sub Winsock1_DataArrival(ByVal bytesTotal As Long)
Dim Data$
Winsock1.GetData Data, vbString
Text1.Text = Text1.Text & Data
End Sub
'### ============================================================= ###
'[출처] Read HTML Source- InternetReadFile (VB, Excel VBA, .NET & SQL) |작성자 서은아빠
'From. http://cafe.naver.com/xlsvba/6
Option Explicit
Private Const INTERNET_OPEN_TYPE_DIRECT = 1
Private Const INTERNET_OPEN_TYPE_PROXY = 3
Private Const INTERNET_FLAG_RELOAD = &H80000000
Private Declare Function InternetOpen Lib "wininet" Alias "InternetOpenA" (ByVal sAgent As String, ByVal lAccessType As Long, ByVal sProxyName As String, ByVal sProxyBypass As String, ByVal lFlags As Long) As Long
Private Declare Function InternetCloseHandle Lib "wininet" (ByRef hInet As Long) As Long
Private Declare Function InternetReadFile Lib "wininet" (ByVal hFile As Long, ByVal sBuffer As String, ByVal lNumBytesToRead As Long, lNumberOfBytesRead As Long) As Integer
Private Declare Function InternetOpenUrl Lib "wininet" Alias "InternetOpenUrlA" (ByVal hInternetSession As Long, ByVal lpszUrl As String, ByVal lpszHeaders As String, ByVal dwHeadersLength As Long, ByVal dwFlags As Long, ByVal dwContext As Long) As Long
'=====================================================================================================
' Function : GetHTMLSource
' Author : 서은아빠(http://cafe.naver.com/xlsvba/6)
' DateTime : 2007-08-08 14:09
' Purpose : 지정된 URL의 HTML소스를 읽어온다.
' INET등의 외부 컨트롤을 이용하지 않고 HTML소스를 읽어오며
' 메뉴프레임정도의 HTML문서의 구성등을 표현하는 페이지의 소스를 읽어올때 적합하다.
' Param : strURL - 해당 URL
' lngBufSize - HTML소스를 받을 Buf사이즈
' Return : 성공 여부 (Boolean)
'=====================================================================================================
Private Function GetHTMLSource(ByVal strURL As String, Optional lngBufSize As Long = 1024) As Boolean
Dim hOpen As Long
Dim hURL As Long
Dim lngRet As Long
Dim strBuf As String
GetHTMLSource = False
'## 공간 할당
strBuf = String(lngBufSize, Chr(0))
'## 인터넷 연결(INTERNET_OPEN_TYPE_DIRECT)
hOpen = InternetOpen(ThisWorkbook.Name, INTERNET_OPEN_TYPE_DIRECT, vbNullString, vbNullString, 0)
'## 지정된 URL연결
hURL = InternetOpenUrl("hOpen, strURL, vbNullString, ByVal 0&, INTERNET_FLAG_RELOAD, ByVal 0&)
If hURL Then
'## 지정된(lngBufSize) 사이즈만큼 해당 URL의 HTML소스를 읽어서 Buf에 담는다.
Call InternetReadFile(hURL, strBuf, lngBufSize, lngRet)
'## 핸들을 초기화한다.
Call InternetCloseHandle(hURL)
'## 공간할당시 담았던 문자를 제거한다.
strBuf = Replace(strBuf, Chr(0), "", , , vbTextCompare)
Debug.Print strBuf
GetHTMLSource = True
End If
Call InternetCloseHandle(hOpen)
End Function
Sub Test()
Call GetHTMLSource("http://examo.co.kr/old_index.html")
End Sub
'### ============================================================= ###
'### ============================================================= ###
'### ============================================================= ###
'### ============================================================= ###
'### ============================================================= ###
'### ============================================================= ###