vb6.0/vba [vb6.0/vba] MSXML2.XmlHttp와 MSXML2.DOMDocument 를 이용한 www.kimsonline.co…
페이지 정보
본문
Sub Test()
Dim pData As String
Dim url As String
Dim sHtml As String
Dim r As Long
'// https://www.kimsonline.co.kr/drugcenter/search/retotalsearch?Keyword=%EA%B8%80%EB%A6%AC%EB%A9%9C&Page=1
url = "https://www.kimsonline.co.kr/Function/GetTotalSearch"
'// Post문자열
pData = "{""parameters"":[{""Key"":""TotalSearchKeyword"",""Value"":""글리멜""}," & _
"{""Key"":""MarketStatus"",""Value"":""AS""}, " & _
"{""Key"":""PageNo"",""Value"":""1""}, " & _
"{""Key"":""RowCount"",""Value"":""200""}]}"
sHtml = getResponse(url, pData)
sHtml = Mid(sHtml, 7) 'remove {"d":"
sHtml = Left(sHtml, Len(sHtml) - 2) 'remove }"
'Debug.Print sHtml
Dim xDoc As Object 'New MSXML2.DOMDocument60
Dim xNodes As Object 'MSXML2.IXMLDOMNodeList
Dim xNode As Object 'MSXML2.IXMLDOMElement
Set xDoc = CreateObject("MSXML2.DOMDocument")
xDoc.LoadXML sHtml
Set xNodes = xDoc.SelectNodes("//DrugList/Item")
Cells.Clear
Range("A1:C1") = Array("이름", "가격", "코드")
r = 1
For Each xNode In xNodes
r = r + 1
'이름
Cells(r, 1) = xNode.getElementsByTagName("ProductNameKr")(0).Text
'가격
Cells(r, 2) = xNode.getElementsByTagName("NHIPrice")(0).Text
'코드
Cells(r, 3).NumberFormat = "@"
Cells(r, 3) = xNode.getElementsByTagName("KDCode")(0).Text
Next xNode
Cells.Columns.AutoFit
Set xDoc = Nothing
End Sub
'// 서버에 접속해서 Response를 가져옴
Function getResponse(sUrl As String, PostData As String)
Dim http As Object
Set http = CreateObject("MSXML2.XmlHttp")
With http
.Open "post", sUrl, False
.setRequestHeader "Accept", "application/json, text/javascript, */*; q=0.01"
.setRequestHeader "Content-Type", "application/json; charset=UTF-8"
.send PostData
'\u003c: <, \u003e: >, \r\n: vbNewLine
getResponse = Replace(Replace(Replace(.responseText, "\u003c", "<"), "\u003e", ">"), "\r\n", "")
'\" => "
getResponse = Replace(getResponse, "\\""", """")
End With
Set http = Nothing
End Function
- 이전글[vb6.0/vba] 한글을 자음 모음으로 나누기 + 합치기 21.01.30
- 다음글[vba] ENCODEURL 21.01.30
댓글목록
등록된 댓글이 없습니다.