[vb6.0/vba] cjwatch.co.kr 상품정보(재고) 크롤링 > vb6.0/vba

vb6.0/vba

출력할 랭킹이 없습니다.

하나를하더라도최선을

2020-05-17 17:28 4,457 0

- 첨부파일 : 2020-05-17dirId11080506docId356691681웹쿼리 문의파일.xlsm (87.9K) - 다운로드

0 2020-05-17 17:30:06

cjwatch.co.kr 사이트의 재고를 긁어오고자 합니다

Sub program1472_com()

    Dim URL As String, T As String, Cookie As String, C As Range

    Set C = Range([d2], Cells(Rows.Count, "D").End(3))

    C.Offset(, 1).ClearContents

    For Each C In C

        URL = C: C.Select

        If InStr(URL, "http") = 1 Then

            With CreateObject("WinHttp.WinHttpRequest.5.1")

                .Open "GET", URL

                .SetRequestHeader "Host", "www.cjwatch.co.kr"

                .SetRequestHeader "User-Agent", "Mozilla/5.0 (Windows NT 10.0; WOW64; rv:56.0) Gecko/20100101 Firefox/56.0"

                .SetRequestHeader "Accept", "text/html,application/xhtml+xml,application/xml;q=0.9,image/webp,*/*;q=0.8"

                .SetRequestHeader "Accept-Language", "ko-KR,ko;q=0.8,en-US;q=0.5,en;q=0.3"

                .SetRequestHeader "Connection", "keep-alive"

                If Len(Cookie) Then .SetRequestHeader "Cookie", Cookie

                .SetRequestHeader "Upgrade-Insecure-Requests", "1"

                .Send

                .WaitForResponse: DoEvents

                T = .ResponseText

            End With

            If InStr(T, "재고수량") Then

                C.Next = Val(Split(Split(T, "재고수량")(1), ">")(3)): If C.Next = 0 Then C.Next = "품절"

            Else

                C.Next = Split(Split(T, "alert(")(1), "'")(1)

            End If

        Else: C.Next = "Error": End If

    Next

    MsgBox "모든 검색을 완료하였습니다."

End Sub

매크로 실행 후 아래처럼 재고를 불러옵니다

등록된 댓글이 없습니다.