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

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

작성자 하나를하더라도최선을
댓글 0건 조회 4,381회 작성일 23-03-11 09:00

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 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

등록된 댓글이 없습니다.