Thread: Transfering Value from Table in Web with Multiple Page Include saving Images

Hello yvanka,

Welcome to the Forum!

After looking at the table, it looks like the picture your are referring to is in the "Barcode" column. Is that correct?

Hello yvanka,

Thanks, that's perfectly clear. Which row and column will the data be transferred to?

Hello yvanka,

Thanks, that's perfectly clear. Which row and column will the data be transferred to?

Hello yvanka,

The attached workbook has the macro below installed. On "Sheet1", row 1 is the header row. There is button added to the row to run the macro.

The macro will attach to a running instance of Internet Explorer. The title in the window is expected to be "Member Area - GS1 Indonesia". If it is not then the title must be changed in the macro. All pictures will be downloaded to the file path in the picture you posted. Change this if you need to.

' Thread:  http://www.excelforum.com/excel-programming/812908-transfering-value-from-table-in-web-with-multiple-page-include-saving-images.html
' Poster:  yvanka
' Author:  Leith Ross
' Written: February 04, 2012

Private Declare Function DownloadPicture _
    Lib "urlmon.dll" _
    Alias "URLDownloadToFileA" _
      (ByVal pCaller As Long, _
       ByVal szURL As String, _
       ByVal szFileName As String, _
       ByVal dwReserved As Long, _
       ByVal lpfnCB As Long) _
    As Long


Sub CopyWebTable()

    Dim Data As Variant
    Dim I As Long
    Dim ieApp As Object
    Dim R As Long
    Dim ShellApp As Object
    Dim PageSource As String
    Dim Pic As Variant
    Dim PicFolder As String
    Dim PicSource As String
    Dim Table As Object
    Dim TableRows As Object
    Dim Tables As Object
    Dim Text As String
    Dim Title As String
    Dim Wks As Worksheet
    Dim Wnd As Object
        
        Title = "Member Area - GS1 Indonesia"
        
        PicFolder = "C:\Documents and Settings\pradhita\My Documents\Downloads\Images\"
            
        Set Wks = Worksheets("Sheet1")
        
        Set Rng = Wks.Range("A2")
        
                R = Wks.Cells(Rows.Count, Rng.Column).End(xlUp).Row
                R = IIf(R < Rng.Row, 0, R - Rng.Row + 1)
                
                Set ShellApp = CreateObject("Shell.Application")
                
                For Each Wnd In ShellApp.Windows
                    If Wnd.Name = "Windows Internet Explorer" Then
                       If Wnd.LocationName = Title Then
                          Set ieApp = Wnd
                          PageSource = Wnd.Document.Body.innerHTML: Exit For
                       End If
                    End If
                Next Wnd
                
                If ieApp Is Nothing Then
                   MsgBox "Please start Internet Explorer," & vbCrLf _
                         & "log in and try again."
                   Exit Sub
                End If
                
                PageSource = Replace(PageSource, vbLf, "")
                PageSource = Replace(PageSource, vbCr, "")
                PageSource = Replace(PageSource, vbTab, "")
                
                Set Tables = ieApp.Document.Body.getElementsByTagName("table")
                Set Table = Tables(2)

                Set TableRows = Table.Rows
                
                    For I = 1 To TableRows.Length - 1
                        ReDim Data(8)
                        With TableRows(I)
                            Data(0) = .Cells(0).ChildNodes(0).innerHTML
                            Data(1) = .Cells(1).ChildNodes(0).innerHTML
                            Data(2) = .Cells(2).ChildNodes(0).innerHTML
                            Data(3) = .Cells(3).ChildNodes(0).innerHTML
                            Data(4) = .Cells(4).ChildNodes(0).innerHTML
                            Data(5) = .Cells(5).ChildNodes(0).innerHTML
                            Data(6) = .Cells(6).ChildNodes(0).innerHTML
                            Data(7) = Data(1) & ".jpg"
                            Data(8) = .Cells(8).ChildNodes(0).innerHTML
                            PicFile = PicFolder & Data(7)
                            PicSource = .Cells(7).ChildNodes(0).src
                        End With
                        
                        Call DownloadPicture(0, PicSource, PicFile, 0, 0)
                        
                        Rng.Offset(R, 0).Resize(1, 9).Value = Data
                        R = R + 1
                    Next I
                
End Sub