[vb6.0vba] [vb6.0/vba] 쿠팡 상품 크롤링
하나를하더라도최선을
2023-03-11 09:00
2,297
0
-
- 첨부파일 : 쿠팡검색만들기.xlsb (63.8K) - 다운로드
본문
Sub 검색()
'/****************** 기존코드
Dim s As Shape
For Each s In ActiveSheet.Shapes
Debug.Print s.Name
If s.Name = "이미지" Then s.Delete
Next
Range("5:10000").ClearContents
'/****************** << 여기까지
'/****************** 변수선언
Dim URL As String, query As String, page As Integer
Dim IE As Object, T As String, Referer As String, Cookie As String
Dim v As Variant, i As Integer
Dim htmlfile As Object, productList As Object, elem As Object
'/****************** 설정
Set IE = CreateObject("WinHttp.WinHttpRequest.5.1")
Set htmlfile = CreateObject("htmlfile") ': htmlfile.Open: htmlfile.Write ""
Cookie = "sid=; " '// 필수 쿠키(없을시 응답 없음, 시간 초과)
query = fn.encode([D2])
'/****************** 무한루프 시작
Do
page = page + 1
URL = URL & "rocketAll=false"
URL = URL & "&q=" & query
URL = URL & "&isPriceRange=false"
URL = URL & "&page=" & page
URL = URL & "&filterSetByUser=true"
URL = URL & "&channel=user"
URL = URL & "&rating=0"
URL = URL & "&sorter=scoreDesc"
URL = URL & "&listSize=100"
With IE
.Open "GET", URL
.SetRequestHeader "Host", "www.coupang.com"
.SetRequestHeader "User-Agent", "Mozilla/5.0 (Windows NT 10.0; Win64; x64; rv:109.0) Gecko/20100101 Firefox/110.0"
.SetRequestHeader "Accept", "text/html,application/xhtml+xml,application/xml;q=0.9,image/avif,image/webp,*/*;q=0.8"
If Len(Cookie) Then .SetRequestHeader "Cookie", Cookie
.SetRequestHeader "Origin", "https://www.coupang.com/"
.Send
.WaitForResponse: DoEvents
T = .ResponseText
End With
SetClipboard T: Stop '// 클립보드에 가져온 HTML 소스 넣고 브레이크
'htmlfile.Write T
htmlfile.body.innerHTML = T
Set productList = htmlfile.getElementById("productList"): i = 0
Do
i = i + 1
Set elem = getXPathElement("/li[" & i & "]", productList)
If Not elem Is Nothing Then
'// 이곳에서 상품 크롤링하면 됩니다.
Debug.Print getXPathElement("/a/dl/dd/div/div[2]", elem).innerTEXT '// 상품명 출력
End If
Loop Until elem Is Nothing
Stop '// 브레이크
Loop Until i < 101
MsgBox "모든 상품을 가져왔습니다."
End Sub
'// 클립보드에 텍스트 넣기
Public Function SetClipboard(ByRef sText As String) As Boolean ' ### 리턴값: 성공 여부
On Error GoTo nErr
Static Clipboard As Object
If Clipboard Is Nothing Then Set Clipboard = CreateObject("new:{1C3B4210-F441-11CE-B9EA-00AA006B1A69}") '// Microsoft Forms 2.0 Object Library
Clipboard.SetText sText: Clipboard.PutInClipboard
SetClipboard = True
nErr:
End Function
'// xPath를 이용한 크롤링을 위한 함수
Public Function getXPathElement(sXPath As String, objElement As Object) As Object
On Error GoTo ErrPass
Dim sXPathArray() As String
Dim sNodeName As String, sNodeNameIndex As String
Dim sRestOfXPath As String
Dim lNodeIndex As Long, lCount As Long
sXPathArray = Split(sXPath, "/")
sNodeNameIndex = sXPathArray(1)
If Not InStr(sNodeNameIndex, "[") > 0 Then
sNodeName = sNodeNameIndex
lNodeIndex = 1
Else
sXPathArray = Split(sNodeNameIndex, "[")
sNodeName = sXPathArray(0)
lNodeIndex = CLng(Left(sXPathArray(1), Len(sXPathArray(1)) - 1))
End If
sRestOfXPath = Right(sXPath, Len(sXPath) - (Len(sNodeNameIndex) + 1))
Set getXPathElement = Nothing
For lCount = 0 To objElement.ChildNodes().Length - 1
If UCase(objElement.ChildNodes().Item(lCount).nodeName) = UCase(sNodeName) Then
If lNodeIndex = 1 Then
If sRestOfXPath = "" Then
Set getXPathElement = objElement.ChildNodes().Item(lCount)
Else
Set getXPathElement = getXPathElement(sRestOfXPath, objElement.ChildNodes().Item(lCount))
End If
End If
lNodeIndex = lNodeIndex - 1
End If
Next lCount
ErrPass:
End Function
댓글목록0