본문 바로가기
카테고리 없음

[vb6.0/vba] 쿠팡 상품 크롤링

by IT HUB 2023. 3. 11.
728x90
반응형

 

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 = "https://www.coupang.com/np/search?"
        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 StringAs 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 ObjectAs 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

 

반응형

댓글