Gagal Scrape Data di Range

  1. 2 tahun lalu

    Salam Sejahtera Semua,

    Saya Awe, saya lagi frustasi dengan kendala di scraping excel saya dalam beberapa minggu ini, karena sudah coba dan cari kemana cara untuk mengatasinya, tetap tidak ketemu,

    Masalah :
    Saya membuat VBA excel untuk mengambil data harga dan kondisi stok barang melalui Link Website barang tersebut
    Ketika saya melalukan action script itu, saya mendapat error box yang mengarah ke barisan harga barang.
    Saya sudah pastikan bahwa tahap pengambilan script sudah benar, tetapi masih belum ketemu juga kenapa bisa muncul error box tersebut.

    Saya sangat berharap Senior-senior yang di Komunitas ini bisa berkenan membantu saya untuk masalah ini,

    Saya berterima kasih sebelumnya atas waktu yang di berika kepada saya

    Salam
    Awe

    @awe

    coba skrip berikut :

    Sub GetFromWeb()
    Dim Ie As New InternetExplorer
    Dim lIdx As Long
    
    Range("c2:d300").Clear
    
    lIdx = Range("A" & Rows.Count).End(xlUp).Row
    With Ie
        For i = 2 To lIdx
        .Visible = False
        .navigate Cells(i, 1).Value
            Do
                DoEvents
            Loop Until .readyState = READYSTATE_COMPLETE
            
            sBuffer = .document.body.innerHTML
            
            'Cek SKU 13 Karakter dahulu
            SKU = Chr$(34) & Right(Sheet1.Cells(i, 1), 13) & Chr$(34) & "," & """sku""" & ":"
            SKUpos = InStr(1, sBuffer, SKU)
            If SKUpos Then
              SKU = Mid(sBuffer, SKUpos + Len(SKU), 10)
              SKU = Replace(SKU, Chr$(34), "")
            End If
            
            'Cari Posisi SKU 8 karakter
            SKUpos = 0
            SKUpos = InStr(1, sBuffer, """sku""" & ":" & Chr$(34) & SKU & Chr$(34))
            
            'Kata kunci pencarian
            xHarga = Chr$(34) & "final" & Chr$(34) & Chr$(58)
            xStok = Chr$(34) & "in_stock" & Chr$(34) & Chr$(58)
            xHargaPos = InStr(SKUpos, sBuffer, xHarga)
            xStokPos = InStr(SKUpos, sBuffer, xStok)
            
                'Harga :
                If xHargaPos Then
                  sTemp = vbNullString
                  sTemp = Mid(sBuffer, xHargaPos + Len(xHarga), 50)
                  sTemp = Mid(sTemp, 1, InStr(1, sTemp, Chr$(44)) - 1)
                  Sheet1.Cells(i, 3) = sTemp
                End If
            
                'Stok :
                If xStokPos Then
                  sTemp = vbNullString
                  sTemp = Mid(sBuffer, xStokPos + Len(xStok), 50)
                  sTemp = Mid(sTemp, 1, InStr(1, sTemp, Chr$(44)) - 1)
    
                    If sTemp = "null" Then
                      Sheet1.Cells(i, 4) = "Stok Tersedia"
                    ElseIf sTemp = "0" Then
                      Sheet1.Cells(i, 4) = "Stok tidak tersedia"
                      Else
                      Sheet1.Cells(i, 4) = "Stok Tinggal " & sTemp
                    End If
                End If
            Next i
    End With
    
    ' Note : hasilnya masih ngawur :P
    Ie.Quit
    Set Ie = Nothing
    Application.StatusBar = ""
    MsgBox "Selesai boss Awe", , "Selamat"
    End Sub

    Note : hasilnya sengaja belum sesuai harapan, silahkan di kembangkan ;)

  2. Di sunting 2 tahun lalu oleh manweljs_

    @awe

    mungkin karena halaman yang dimaksud tidak termuat secara utuh di InternetExplore, saya coba ambil harga di situs lain baik-baik aja,

    Sub GetFromWeb()
    Dim IE As New InternetExplorer
    Dim htmlDoc As HTMLDocument
    Dim Harga As String
    
    IE.Visible = False
    IE.navigate "https://www.tokopedia.com/jorkaefgame/tombol-reset-super-slim?src=topads"
    Do
        DoEvents
    Loop Until IE.readyState = READYSTATE_COMPLETE
    Set htmlDoc = IE.document
    Harga = htmlDoc.getElementsByClassName("rvm-price mr-15")(0).innerText
    MsgBox Harga
    IE.Quit
    End Sub

    sementara kalau ambil konten lain dari situs pada file (misalnya nama barang) bisa

    Sub GetFromWeb()
    Dim IE As New InternetExplorer
    Dim htmlDoc As HTMLDocument
    Dim NamaBarang As String
    
    IE.Visible = False
    IE.navigate "https://www.jakmall.com/abc-store/sol-sepatu-memory-foam-1-pasang#7012901751858"
    Do
        DoEvents
    Loop Until IE.readyState = READYSTATE_COMPLETE
    Set htmlDoc = IE.document
    NamaBarang = htmlDoc.getElementsByClassName("dp__name")(0).innerText
    MsgBox NamaBarang
    IE.Quit
    End Sub

    kalau ada alternatif solusi dari teman2 lain, silahkan dibantu

  3. @manweljs_
    Terima kasih atas respon dan jawabannya.
    Saya memcoba untuk mengambil harga dengan script yang bpak berikan di atas tetapi tidak bisa, apakah saya ada miss sesuatu atau get elementnya salah untuk mengambil harga barang dari website tersebut?

    Sub GetFromWeb()
    Dim IE As New InternetExplorer
    Dim htmlDoc As HTMLDocument
    Dim NamaBarang As String

    IE.Visible = False
    IE.navigate "https://www.jakmall.com/abc-store/sol-sepatu-memory-foam-1-pasang#7012901751858"
    Do
    DoEvents
    Loop Until IE.readyState = READYSTATE_COMPLETE
    Set htmlDoc = IE.document
    NamaBarang = htmlDoc.getElementsByClassName("dp__price dp__price--2")(0).innerText
    MsgBox NamaBarang
    IE.Quit
    End Sub

    Terima kasih sebelumnya
    Salam
    Awe

  4. Di sunting 2 tahun lalu oleh manweljs_

    @awe Saya memcoba untuk mengambil harga dengan script yang bpak berikan di atas tetapi tidak bisa, apakah saya ada miss sesuatu atau get elementnya salah untuk mengambil harga barang dari website tersebut?

    seperti yang saya sampaikan diatas, bahwa kemungkinannya adalah karena halaman yang dimaksud tidak termuat secara utuh di InternetExplore. berikut tampilannya :

    19.PNG

    sedangkan kalau menggunakan browser lain, tampilannya :

    20.PNG

    jadi halaman tersebut jika di buka dengan Internet Explore, class "dp__price dp__price--2" tidak ditemukan. demikian asumsi dari saya.

    semoga ada teman-teman lain yang punya solusinya, misalnya ambil data dari chrome

  5. Caton

    13 Nov 2018 Terverifikasi Indonesia + 16.046 Poin

    @awe ... Ketika saya melalukan action script itu, saya mendapat error box yang mengarah ke barisan harga barang. Saya sudah pastikan bahwa tahap pengambilan script sudah benar, tetapi masih belum ketemu juga kenapa bisa muncul error box tersebut ...

    Script yang mas @Awe buat sebenarnya tidak ada masalah, jika elemen HTML yang mau diambil memang ada pada objek HTMLDocument. Script berikut ini:

    ...
    Set hargaawal = html.getElementsByClassName("dp__price dp__price--2")(0)
    ...

    gagal dikarenakan elemen yang dimaksud memang tidak ada pada objek objek HTMLDocument, meski status dokumen sudah lengkap (Document Complete). Mengapa ini terjadi? Karena pada dokumen tersebut ada JavaScript yang baru akan dieksekusi saat dokumen sudah selesai di download. Penampakan scriptnya seperti berikut:

    render.png

    Fungsi JavaScript tersebut yang akan merender kembali sebagian elemen ke halaman dokumen. Jadi, memang ada sebagian elemen yang oleh programmernya sengaja disusun agar tidak dirender secara langsung oleh Web Browser ... :)

    Dari pengalaman saya pribadi, sejauh ini saya temukan ada 2 teknik yang digunakan untuk merender kembali elemen pada dokumen HTML. Keduanya sama-sama menggunakan JavaScript. Yang pertama, data elemen yang akan di render disimpan pada variabel (seperti kasus pada situs di atas), kedua data diambil melalui JSON baru kemudian dirender. Contoh variabel untuk kasus di atas:

    script.png

    Solusinya mungkin tidak terlalu sulit. Mas @Awe bisa mencoba mencari teks tertentu (parsing) dari objek body.InnerHTML. Misalkan untuk harga barang, cari teks "final":, untuk stok barang, cari teks "in_stock" (semua teks termasuk tanda petik/kutip). Misalkan saja:

    ...
    Set xHTMLDoc = xIE.Document
    sBuffer = xHTMLDoc.body.innerHTML
    sKey = Chr$(34) & "final" & Chr$(34) & Chr$(58)
    lPos = InStr(1, sBuffer, sKey) 
    
    If lPos Then
      sTemp = Mid(sBuffer, lPos + Len(sKey), 50)   
      sTemp = Mid(sTemp, 1, InStr(1, sTemp, Chr$(44)) - 1)
      Sheet1.Cells(2, 3) = CDbl(sTemp)
    End If
    ...

    Konsep alur prosesnya ± seperti itu. Silahkan dicoba dahulu. Jika sudah pusing, nanti saya buatkan contoh script. Dan tolong, jangan frustasi ... ;)

    Demikian.

  6. Di sunting 2 tahun lalu oleh manweljs_

    @Caton ...Karena pada dokumen tersebut ada JavaScript yang baru akan dieksekusi saat dokumen sudah selesai di download...

    Ooo gitu toh...

    terus kenapa IE tidak mengeksekusi JavaScript tersebut mas ?

    btw, tengkiu infonya mas

  7. Caton

    13 Nov 2018 Terverifikasi Indonesia + 16.046 Poin
    Di sunting 2 tahun lalu oleh Caton

    @manweljs_ ... terus kenapa IE tidak mengeksekusi JavaScript tersebut mas ...

    Karena script JS tersebut memang dipasang agar terpicu saat dokumen sudah lengkap (biasanya dalam JQuery memanfaatkan event $(document).ready atau pada JS memanfaatkan event window.onload. Jadi, saat semua elemen sudah terloading, yakni elemen:

    <!DOCTYPE html>
    ...
    </html>

    dan seluruh elemen di dalam tag html tersebut selesai diloading dan dirender, maka script tersebut baru dieksekusi. IE sendiri tetap mengeksekusi JS tersebut, namun masalahnya, objek IE hanya memicu even saat dokumen lengkap diloading saja, tidak saat proses yang dikerjakan melalui JS selesai (mungkin bisa saja dengan trik-trik tertentu, namun sejauh ini saya belum menemukan caranya).

    Demikian.

  8. Di sunting 2 tahun lalu oleh manweljs_

    @Caton Konsep alur prosesnya ± seperti itu.

    mas nanya lagi yak,

    mengenai :

    sBuffer = xHTMLDoc.body.innerHTML
    sKey = Chr$(34) & "final" & Chr$(34) & Chr$(58)

    skrip contoh diatas sudah saya coba dan berhasil, namun saya heran aja kalo nilai dari sBuffer saya letakan pada salah satu sel, kemudian saya cari manual kata "final" menggunakan FIND atau SEARCH kok gak ketemu yak ? (^_^)/

    22.PNG

  9. Caton

    13 Nov 2018 Terverifikasi Indonesia + 16.046 Poin

    @manweljs_ ... kalo nilai dari sBuffer saya letakan pada salah satu sel, kemudian saya cari manual kata "final" menggunakan FIND atau SEARCH kok gak ketemu ...

    Setiap sel hanya dapat menampung maksimal 32,767 karakter. Sementara sBuffer tersebut menampung sekitar 99,927 karakter.

    Demikian.

  10. @Caton Setiap sel hanya dapat menampung maksimal 32,767 karakter. Sementara sBuffer tersebut menampung sekitar 99,927 karakter.

    I see!

    thanks

  11. @manweljs_ @Caton

    Terima kasih mas Caton dan Man untuk terikut dalam masalah saya, hehe
    Saya coba segala cara yang saya tau dari konsep penjelasan mas di atas.
    Terima kasih sudah meberikan penjelasannya ya,

    Akan saya update di perkembangan nya disini yaa,

    Sekalli lagi terima kasih

  12. Di sunting 2 tahun lalu oleh manweljs_

    @awe

    berikut contoh skrip untuk harga lama dan harga baru, untuk status saya kurang paham yang mana yang diambil jadi silahkan dikembangkan ;)

    Sub GetFromWeb()
    Dim Ie As New InternetExplorer
    Dim Doc As HTMLDocument
    Dim lIdx As Long
    
    lIdx = Range("A" & Rows.Count).End(xlUp).Row
    For i = 2 To lIdx
        With Ie
            .Visible = False
            .navigate Cells(i, 1).Value
        Do
            DoEvents
        Loop Until .readyState = READYSTATE_COMPLETE
        
        Set xHTMLDoc = .document
        sBuffer = xHTMLDoc.body.innerHTML
        HargaLama = Chr$(34) & "list" & Chr$(34) & Chr$(58)
        HargaBaru = Chr$(34) & "final" & Chr$(34) & Chr$(58)
        Idx1 = InStr(1, sBuffer, HargaLama)
        Idx2 = InStr(1, sBuffer, HargaBaru)
    
        If Idx1 Then
          sTemp = vbNullString
          sTemp = Mid(sBuffer, Idx1 + Len(HargaLama), 50)
          sTemp = Mid(sTemp, 1, InStr(1, sTemp, Chr$(44)) - 1)
          Sheet1.Cells(i, 3) = sTemp
        End If
        If Idx2 Then
          sTemp = vbNullString
          sTemp = Mid(sBuffer, Idx2 + Len(HargaBaru), 50)
          sTemp = Mid(sTemp, 1, InStr(1, sTemp, Chr$(44)) - 1)
          Sheet1.Cells(i, 5) = sTemp
        End If
        End With
    Next i
    End Sub

    sorry ada update sedikit, pengaruh copy paste (^_^)/

  13. @manweljs_

    Terima kasih banyak Mas man, saya coba gabungkan dengan script yang ada,
    akan saya update hasilnya.
    Sekali lagi terima kasih dan mohon maaf kan saya kalau ini membuat mas pusing, hehehe

  14. @manweljs_ @Caton

    Terima kasih Saya sudah berhasil untuk mengambil harga dari script yang mas Man berikan, tetapi Yang seharusnya Stok Tersedia dan Stok Tinggal malah jadi Stok tidak tersedia
    -image-

    Jadi status Stok di website tersebut ada 3 Kondisi

    1. Stok Tersedia = dp__stock dp__stock--ready
    2. Stok tidak tersedia = dp__stock dp__stock--empty
    3. Stok Tinggal 5 / 4 / 3 / 2 / 1 = dp__stock dp__stock--limited

    Tetapi hasil pengambilan data di element tersebut (span)

    1. check_circle Stok Tersedia
    2. highlight_off Stok tidak tersedia
    3. info Stok Tinggal 5 / 4 / 3 / 2 /1

    Sehingga saya menggunakan script ini untuk menghilang kata yang gak terpakai

    'cleaning Status Stock
    ActiveCell.Replace What:="*check_circle", Replacement:="", LookAt:=xlPart, _
    SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
    ReplaceFormat:=False
    ActiveCell.Replace What:="info", Replacement:="", LookAt:=xlPart, _
    SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
    ReplaceFormat:=False
    ActiveCell.Replace What:="highlight_off", Replacement:="", LookAt:=xlPart, _
    SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
    ReplaceFormat:=False

    Berikut script saya saat ini, dan sudah ada saya lampirkan excelnya
    Apakah saya ada menloncatkan action cek status stok dari script ini atau gimana mas?
    Mohon maaf sebelumnya untuk tanya lagi, karena saya sudah stuck, dan otak atik tidak mendapatkan hasil.

    Sub Grab()
    Dim ie As InternetExplorer
    Dim html As HTMLDocument
    Dim URLNAME As String
    Dim sht As Worksheet
    Dim LastRow As Long
    Dim stok
    Dim hargarp As String

    Set sht = ActiveSheet
    baris_akhir = sht.Cells(sht.Rows.Count, "A").End(xlUp).Row
    'MsgBox baris_akhir

    For i = 2 To baris_akhir
    URLNAME = Cells(i, 1).Value

    Set ie = New InternetExplorer
    ie.Visible = False

    ie.navigate URLNAME

    Do
    DoEvents
    Sleep 250
    Loop Until ie.readyState = READYSTATE_COMPLETE

    Set html = ie.document
    sBuffer = html.body.innerHTML
    HargaBaru = Chr$(34) & "final" & Chr$(34) & Chr$(58)
    Idx2 = InStr(1, sBuffer, HargaBaru)
    If Idx2 Then
    sTemp = vbNullString
    sTemp = Mid(sBuffer, Idx2 + Len(HargaBaru), 50)
    sTemp = Mid(sTemp, 1, InStr(1, sTemp, Chr$(44)) - 1)
    End If

    Set stok = html.getElementsByClassName("dp__stock dp__stock--ready")(0)
    'cek apakah stok banyak atau sedikit.
    If stok Is Nothing Then
    Set stok = html.getElementsByClassName("dp__stock dp__stock--limited")(0)
    Else
    End If
    If stok Is Nothing Then
    Set stok = html.getElementsByClassName("dp__stock dp__stock--empty")(0)
    Else
    End If

    'Tool sementara :
    'Debug.Print namabarang.className
    'Debug.Print namabarang.innerText
    'MsgBox statusstok

    'Harga awal
    Cells(i, 3).Select
    Cells(i, 3).Value = sTemp

    'Status Stock
    Cells(i, 4).Select
    'If statusstok.innerText = "email" Then Cells(I, 6).Value = "Stock Tersedia"
    Cells(i, 4).Value = stok.innerText

    'cleaning Status Stock
    ActiveCell.Replace What:="*check_circle", Replacement:="", LookAt:=xlPart, _
    SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
    ReplaceFormat:=False
    ActiveCell.Replace What:="info", Replacement:="", LookAt:=xlPart, _
    SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
    ReplaceFormat:=False
    ActiveCell.Replace What:="highlight_off", Replacement:="", LookAt:=xlPart, _
    SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
    ReplaceFormat:=False

    ie.Quit
    Set ie = Nothing
    Application.StatusBar = ""
    On Error Resume Next

    Next i
    MsgBox "Grabing data sudah selesai boss besar, :-)", , "Box"

    End Sub

  15. Caton

    14 Nov 2018 Terverifikasi Indonesia + 16.046 Poin

    @awe ... Apakah saya ada menloncatkan action cek status stok dari script ini atau gimana mas ...

    Seperti yang saya jelaskan, jika mas @Awe mencoba mencari ke dalam elemen HTML Document, besar kemungkinan tidak akan menemukan elemen yang dicari. Sebenarnya, untuk status stok ini saya sudah kasih petunjuk pada penjelasan awal saya di atas:

    ... untuk stok barang, cari teks "in_stock" ...

    Coba perhatikan gambar berikut:

    -image-

    Periksa 2 baris di atas baris yang ditandai, ada 2 variabel data di situ, "in_stock" dan "in_limited_stock". Jadi untuk memeriksa ketersediaan stok, cukup cari teks in_stock. Nilainya berupa TRUE (tersedia) atau FALSE (tidak tersedia). Jika stok merupakan stok terbatas, maka cari teks in_limited_stock yang nilainya juga Boolean. Sedangkan jumlah stoknya, dapat mencari teks "limited_stock" dengan nilai numerik.

    Jadi, dengan konsep alur proses yang sudah saya sampaikan dan sudah diimplementasikan oleh mas @manweljs_ di atas, mas @Awe dapat mencari data yang diinginkan. Misalkan untuk status stok barang ± dicari dengan cara yang serupa:

    ...
    sKey = Chr$(34) & "in_stock" & Chr$(34) & Chr$(58)
    lPos = InStr(1, sBuffer, sKey) 
    
    If lPos Then
      sTemp = Mid(sBuffer, lPos + Len(sKey), 50)   
      sTemp = Mid(sTemp, 1, InStr(1, sTemp, Chr$(44)) - 1)
      '+-- Periksa apakah stok tersedia:
      If Cbool(sTemp) Then
        Sheet1.Cells(2, 3) = "Stok Tersedia"
      Else
        Sheet1.Cells(2, 3) = "Stok Tidak Tersedia"
      End IF
    End If
    ...

    Demikian.

  16. @manweljs_ @Caton
    Mas man dan caton terima kasih atas petunjuk dan arahan,
    Akhirnya saya sudah bisa dan menemukan semua yang saya perlukan.
    Semoga Mas Man dan Caton di berkati Tuhan dan selalu sehat jasmani, sukses terus yaa Mas,

    Salam
    Awe

  17. @awe ...Akhirnya saya sudah bisa dan menemukan semua yang saya perlukan....

    selamat ya

    jangan ragu kalo mau mampir lagi ;)

  18. @manweljs_ @Caton

    Mas mohon maaf ketemu problem lagi,
    Ada produk yang mempunyai beberapa macam variasi warna dan ukuran
    Jadi "in_stock" di body html pasti lebih dari 1.
    Kalau menggunakan Script dibawah ini, dia akan mengambil string "in_stock" pertama sedangkan setiap variasi mempunyai masing2 stok.

    sKey = Chr$(34) & "in_stock" & Chr$(34) & Chr$(58)
    lPos = InStr(1, sBuffer, sKey)

    If lPos Then
    sTemp = Mid(sBuffer, lPos + Len(sKey), 50)
    sTemp = Mid(sTemp, 1, InStr(1, sTemp, Chr$(44)) - 1)

    Contoh Barang:
    https://www.jakmall.com/computindo/cover-hujan-sepatu#2644383360843
    Barang itu mempunyai 3 Ukuran, yaitu:

    1. L
    2. XL
    3. XXL

    Link yang di tuju itu adalah ukuran XXL yang statusnya "in_stock":false
    Jadi ketika jalankan Script di atas,
    String yang di dapatkan adalah "in_stock":true

    -image-

    Saya lagi pelajari sistem karakter Chr yang bisa di aplikasikan di script saya supaya pengambilan stringnya lebih spesifik ke variasi yang kita mau.
    Tapi sampai saat ini masih belum ketemu scriptnya, sudah coba dari semalam sampai saat ini,
    Barangkali Mas sudah bisa buka jalan / petunjuk untuk saya, hehe

    Thank You
    Salam

    Awe

  19. Di sunting 2 tahun lalu oleh manweljs_

    @awe

    itu "In_stok" nya ada 4, "final" nya pun ada 4 saya jadi bingung mau diambil yang mana.

    kalo ide saya tahapannya kira-kira seperti ini :

    1. hitung ada berapa keyword "in_stok" dari sBuffer (contohnya 4)
    2. replace keyword dengan nilai atau karakter unik sebagai keyword baru, (misalnya target nya adalah "in_stok" yang ke 4 di ganti dengan "#iniTARGETNYA#"
    3. Ulangi pencarian dengan keyword baru tersebut
    4. seterusnya sama seperti sebelumnya

    namun yang pertama kali harus ditentukan adalah :
    kalau keywordnya lebih dari 1 maka yang ke berapa yang diambil

  20. @manweljs_

    Setiap produk link yang di tuju pasti punya SKU,
    "sku" itu biasa berapa 8 huruf
    Contoh b]"sku":OMTP2VBL[/b]
    -image-

    Jadi apakah bisa jika perintahnyy seperti ini:

    1. Ke link Produk
    2. Cari sku dari link produk tersebut
    3. Baru cari "in_stock" dari "sku" tersebut

    Maaf mas apakah bisa scriptnya berjalan seperti itu?

    Terima kasih mas

  21. Newer ›
 

atau Mendaftar untuk ikut berdiskusi!