Resources
  • Home
  • December-Chrono
  • Psalm136Personalized
  • ExcelResources
    • 99PublicFunctions
    • aDelimitedCodeTemplate
    • aCodeTemplate
    • aBetter_Code_Template
    • ApplyFormulaValue
    • ArrayPublic
    • ArrayMatchCopyRow
    • Capitalization
    • Colors
    • DataTypes
    • DeleteRows
    • Filter
    • FormatStandard
    • Forms
    • Grid
    • Headers
    • ImageScrape
    • InputBox
  • ExcelResources2
    • Like
    • List Review
    • MatchAndReturn
    • mod_Import
    • Numbers
    • PDF_Parse
    • RandomGenerator
    • iRe1
    • Rept
    • RelatedItemsLIst
    • RomanNumerals
    • SheetSplitter
    • Sort
    • Split Method
    • String_DataType
    • TabDelimited
    • Tab_InsertNew_or_ClearExisting
    • Unique_List
      • UniqueLIsts_FilterMethod
  • Excelresources_Files
    • FileLists
    • FileTextParse
    • Folders
  • excelresources_WebScrape
    • CreateList_1-Href_2-Jpg
    • TableData_Load_PlugPlay
    • CreateList_MultiPage_Image_Link
      • ImageDownload_WebLink_List
    • TableData_Load_ClassDiv
    • TableData_Load_ClassSpan
  • Houseboat Vacation
  • At the Foot of the King
  • Devotions
  • Mentoring
  • Inspirational Stories
    • Vacuum Lifting
  • Job Help
  • Resources
    • MS
    • Florida History
  • Contact
  • Heroscape
    • Fish
    • Playstation
  • You Tube Videos
  • House
    • Tiny Houses
    • Backyards
  • CampingResources
    • CampingLand
    • LED Throwies
  • Interesting
  • Recipes
  • Xbox
  • Skydiving
  • ReadingPlan-5Year
  • Desoto
  • BibleStudy
  • HurricaneIrma
  • Home
  • December-Chrono
  • Psalm136Personalized
  • ExcelResources
    • 99PublicFunctions
    • aDelimitedCodeTemplate
    • aCodeTemplate
    • aBetter_Code_Template
    • ApplyFormulaValue
    • ArrayPublic
    • ArrayMatchCopyRow
    • Capitalization
    • Colors
    • DataTypes
    • DeleteRows
    • Filter
    • FormatStandard
    • Forms
    • Grid
    • Headers
    • ImageScrape
    • InputBox
  • ExcelResources2
    • Like
    • List Review
    • MatchAndReturn
    • mod_Import
    • Numbers
    • PDF_Parse
    • RandomGenerator
    • iRe1
    • Rept
    • RelatedItemsLIst
    • RomanNumerals
    • SheetSplitter
    • Sort
    • Split Method
    • String_DataType
    • TabDelimited
    • Tab_InsertNew_or_ClearExisting
    • Unique_List
      • UniqueLIsts_FilterMethod
  • Excelresources_Files
    • FileLists
    • FileTextParse
    • Folders
  • excelresources_WebScrape
    • CreateList_1-Href_2-Jpg
    • TableData_Load_PlugPlay
    • CreateList_MultiPage_Image_Link
      • ImageDownload_WebLink_List
    • TableData_Load_ClassDiv
    • TableData_Load_ClassSpan
  • Houseboat Vacation
  • At the Foot of the King
  • Devotions
  • Mentoring
  • Inspirational Stories
    • Vacuum Lifting
  • Job Help
  • Resources
    • MS
    • Florida History
  • Contact
  • Heroscape
    • Fish
    • Playstation
  • You Tube Videos
  • House
    • Tiny Houses
    • Backyards
  • CampingResources
    • CampingLand
    • LED Throwies
  • Interesting
  • Recipes
  • Xbox
  • Skydiving
  • ReadingPlan-5Year
  • Desoto
  • BibleStudy
  • HurricaneIrma
Connect on Facebook

Load Table Data
<class>
<span>

When a Website has data arranged in some type of table format:

Picture

...But you would like it to look something like this (In Excel):

Picture

Check the source code for Labels to use (and adapt code as needed)

1) Create a string that contains the Headers
2) Create a list of links that contain the individual pages
3) Create a loop that calls the function and loads data for each row based on the Column A value
4) Each website is different - code looks at things like:
     a) Class Labels / Values (["my_title">"], ["my_data">""])
     b) Close Tags (</span>)


Call the function using this method:

Picture

Here is a sample of the code:

Function WebScrape_ProductPage_TV(MyTab As Variant, MyRow As Variant, MyDumpCol As Variant, MyLinkCol As Variant)
'Enum READYSTATE
'    READYSTATE_UNINITIALIZED = 0
'    READYSTATE_LOADING = 1
'    READYSTATE_LOADED = 2
'    READYSTATE_INTERACTIVE = 3
'    READYSTATE_COMPLETE = 4
'End Enum

'===================================================================================================================================
Dim iLabelStart As Long, iLabelMid As Long, iLabelEnd As Long
Dim iValueStart As Long, iValueMid As Long, iValueEnd As Long
Dim sTempLabel As String, sTempValue As String

Dim bStartMidEndOK As Boolean
Dim sClassLabel As String, sClassValue As String
Dim sSpanStart As String, sSpanEnd As String

sSpanStart = ">"
sSpanEnd = "</span>"
sClassLabel = "col6 acol12 valueWrapper attrLabel  "
sClassValue = "col6 acol12 valueWrapper attrValue"
'===================================================================================================================================

Dim sWebLink As String

Dim iLoop As Long, sQuote As String, sTempA As String, sTempB As String, sTempC As String, sTempD As String, sTempE As String, sTempF As String, sTempG As String
Dim iTempA As Long, iTempB As Long, iTempC As Long, iTempD As Long, iTempE As Long, iTempF As Long, iTempG As Long
Dim iCloseTagA As Long, iStartVal As Long
Dim sHref As String, sAmp As String, sDelimiter As String, sMarkStart As String

Dim iUboundR As Long, iUboundC As Long, aDump() As Variant
Dim Ws1 As Long, iNextRow As Long
Dim sHeader As String, aSplitMe As Variant
Dim aHeaders() As Variant

'OOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOO
Erase aDump: Erase aHeaders
Ws1 = Worksheets(MyTab).Index
iNextRow = MyRow
sQuote = """"

'SSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSS
sHeader = "Heat^Mildew^Color^Fabric^Width^Cat^Gvmt^Put Up^Style^Weight^Warranty^Water^Count^Package^"

    'Split String (Populate Public Array: Row1-Headers)
    aSplitMe = Split(sHeader, "^")

'AAAAAAAAAAAAAAAAAAAAAAAAAAAAA
    iUboundC = Len(sHeader) - Len(Replace(sHeader, "^", "", , , vbTextCompare))
    aHeaders = Range(Worksheets(Ws1).Cells(iNextRow, MyDumpCol).Address, Worksheets(Ws1).Cells(iNextRow, MyDumpCol + iUboundC).Address)
'AAAAAAAAAAAAAAAAAAAAAAAAAAAAA

       'Load All non blank values into the Array (Header Position)
    For iLoop = LBound(aSplitMe) To UBound(aSplitMe)
        If aSplitMe(iLoop) <> "" Then aHeaders(1, iLoop + 1) = aSplitMe(iLoop)
    Next iLoop
'===================================================================================================
Worksheets(Ws1).Select
Set Destination = Range(Worksheets(Ws1).Cells(1, MyDumpCol).Address)
Destination.Resize(UBound(aHeaders, 1), UBound(aHeaders, 2)).Value = aHeaders
'===================================================================================================
'SSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSS
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''

    
'to refer to the running copy of Internet Explorer
    Dim oWebBrowser As InternetExplorer

'to refer to the HTML document returned
    Dim sHTML As HTMLDocument

'open Internet Explorer in memory, and go to website
    Set oWebBrowser = New InternetExplorer
    oWebBrowser.Visible = False
    oWebBrowser.navigate sWebLink '"https://www.tv

'Wait until IE is done loading page
    Do While oWebBrowser.READYSTATE <> READYSTATE_COMPLETE
        Application.StatusBar = "Trying to go to website ..."
        DoEvents
    Loop

'show text of HTML document returned
    Set sHTML = oWebBrowser.document
    sTempA = sHTML.DocumentElement.innerHTML

    sTempA = Replace(sTempA, Chr(13), "", , , vbTextCompare)
    sTempA = Replace(sTempA, Chr(10), "", , , vbTextCompare)
    sTempA = Replace(sTempA, vbTab, "", , , vbTextCompare)
    
'AAAAAAAAAAAAAAAAAAAAAAAAAAAAA
    aDump = Range(Worksheets(Ws1).Cells(iNextRow, MyDumpCol).Address, Worksheets(Ws1).Cells(iNextRow, MyDumpCol + iUboundC).Address)
'AAAAAAAAAAAAAAAAAAAAAAAAAAAAA

'===================================================================================================================================
'===================================================================================================================================
'Initiate the loop

    iTempA = 1
    Application.StatusBar = "Reviewing the HTML string"
'===================================================================================================================================
'===================================================================================================================================


'===================================================================================================================================
'===================================================================================================================================
'===================================================================================================================================

gReviewHTMLstringReWrite:
DoEvents
    bStartMidEndOK = True
    sTempLabel = ""
    sTempValue = ""
'===================================================================================================================================
'===================================================================================================================================
'===================================================================================================================================

'===================================================================================================================================
'Set the 3 markers for [Label][Value]



iLabelStart = InStr(iTempA, sTempA, sClassLabel, vbTextCompare)                 'InStr(1, sTempA, "col6 acol12 valueWrapper attrLabel  ", vbTextCompare)
iLabelEnd = InStr(iLabelStart + 1, sTempA, sSpanEnd, vbTextCompare)             'InStr(iLabelStart + 1, sTempA, "</span>", vbTextCompare)
iLabelMid = InStrRev(sTempA, sSpanStart, iLabelEnd - 1, vbTextCompare)          'InStrRev(sTempA, "<", iLabelEnd - 1, vbTextCompare)


iValueStart = InStr(iTempA, sTempA, sClassValue, vbTextCompare)                 'InStr(1, sTempA, "col6 acol12 valueWrapper attrValue", vbTextCompare)
iValueEnd = InStr(iValueStart + 1, sTempA, sSpanEnd, vbTextCompare)             'InStr(iValueStart + 1, sTempA, "</span>", vbTextCompare)
iValueMid = InStrRev(sTempA, sSpanStart, iValueEnd - 1, vbTextCompare)          'InStrRev(sTempA, "<", iValueEnd - 1, vbTextCompare)

'===================================================================================================================================
'Test Label / Value Markers:

If iLabelMid <= iLabelStart Or iLabelMid >= iLabelEnd Then bStartMidEndOK = False
If iValueMid <= iValueStart Or iValueMid >= iValueEnd Then bStartMidEndOK = False
    If bStartMidEndOK = False Then
        'send it to the error handler
        GoTo gMark3Error
    Else
        'Continue processing
        GoTo gMark3Valid
    End If
    
'===================================================================================================================================
gMark3Error:
    Debug.Print "The Start, Mid or End value for a string MARKING step [Label][Value] was invalid."
    GoTo gFinishedWithReview
    
gMark3Valid:
    sTempLabel = Trim(Mid(sTempA, iLabelMid + 1, iLabelEnd - iLabelMid - 1))
    sTempValue = Trim(Mid(sTempA, iValueMid + 1, iValueEnd - iValueMid - 1))
    GoTo gCheckForMatchingHeader
    
'===================================================================================================================================
gCheckForMatchingHeader:
    'Reset Value so no value is over-written when no match to header is made
    iTempG = 0
    
    'check to see if the Label matches a correct Header value
    For iLoop = LBound(aDump, 2) To UBound(aDump, 2)
        If UCase(sTempLabel) = UCase(aHeaders(1, iLoop)) Then
            iTempG = iLoop
            GoTo gMatchMadeDoSomething
        End If
    Next iLoop
'===================================================================================================================================
gMatchMadeDoSomething:
    'Test if Col Position Defined
    If iTempG = 0 Then GoTo gIncrementStartSearchPosition
    
    'populate Array
        Application.StatusBar = "Processing a Match: " & iNextRow & " | " & sTempLabel & "(" & Left(sTempValue, 50) & ")"
        aDump(1, iTempG) = sTempValue
    GoTo gIncrementStartSearchPosition
    
   
gIncrementStartSearchPosition:
    iTempA = InStr(iLabelStart + 1, sTempA, sClassLabel, vbTextCompare)
        'A:Stop the process - no more matches
            If iTempA = 0 Then GoTo gFinishedWithReview
        'B: Check the remainder of the string - more matches available
            GoTo gReviewHTMLstringReWrite
'===================================================================================================================================
'===================================================================================================================================
'===================================================================================================================================
    

'++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++


gFinishedWithReview:
    'Dump the results:
'===================================================================================================

Worksheets(Ws1).Select
Set Destination = Range(Worksheets(Ws1).Cells(iNextRow, MyDumpCol).Address)
Destination.Resize(UBound(aDump, 1), UBound(aDump, 2)).Value = aDump
'===================================================================================================

GoTo gMemoryCleanup

gMemoryCleanup:
'close down oWebBrowser and reset status bar
    oWebBrowser.Quit
    Set oWebBrowser = Nothing
    Application.StatusBar = ""

gArrayMemoryCleanupOnly:
'Release Array memory
    Erase aDump: Erase aHeaders

MsgBox "Done"
End Function
Powered by Create your own unique website with customizable templates.
  • Home
  • December-Chrono
  • Psalm136Personalized
  • ExcelResources
    • 99PublicFunctions
    • aDelimitedCodeTemplate
    • aCodeTemplate
    • aBetter_Code_Template
    • ApplyFormulaValue
    • ArrayPublic
    • ArrayMatchCopyRow
    • Capitalization
    • Colors
    • DataTypes
    • DeleteRows
    • Filter
    • FormatStandard
    • Forms
    • Grid
    • Headers
    • ImageScrape
    • InputBox
  • ExcelResources2
    • Like
    • List Review
    • MatchAndReturn
    • mod_Import
    • Numbers
    • PDF_Parse
    • RandomGenerator
    • iRe1
    • Rept
    • RelatedItemsLIst
    • RomanNumerals
    • SheetSplitter
    • Sort
    • Split Method
    • String_DataType
    • TabDelimited
    • Tab_InsertNew_or_ClearExisting
    • Unique_List
      • UniqueLIsts_FilterMethod
  • Excelresources_Files
    • FileLists
    • FileTextParse
    • Folders
  • excelresources_WebScrape
    • CreateList_1-Href_2-Jpg
    • TableData_Load_PlugPlay
    • CreateList_MultiPage_Image_Link
      • ImageDownload_WebLink_List
    • TableData_Load_ClassDiv
    • TableData_Load_ClassSpan
  • Houseboat Vacation
  • At the Foot of the King
  • Devotions
  • Mentoring
  • Inspirational Stories
    • Vacuum Lifting
  • Job Help
  • Resources
    • MS
    • Florida History
  • Contact
  • Heroscape
    • Fish
    • Playstation
  • You Tube Videos
  • House
    • Tiny Houses
    • Backyards
  • CampingResources
    • CampingLand
    • LED Throwies
  • Interesting
  • Recipes
  • Xbox
  • Skydiving
  • ReadingPlan-5Year
  • Desoto
  • BibleStudy
  • HurricaneIrma