Skip to content

Instantly share code, notes, and snippets.

@ronknight

ronknight/ExtractItemNumbers.xlsm

Created February 5, 2025 19:40
Show Gist options

  • Select an option

    Learn more about clone URLs
  • Save ronknight/a9d5ed5a42993e11a05b8a287d5ffbc8 to your computer and use it in GitHub Desktop.

Select an option

Learn more about clone URLs
Save ronknight/a9d5ed5a42993e11a05b8a287d5ffbc8 to your computer and use it in GitHub Desktop.
Download ZIP

Revisions

  1. ronknight created this gist Feb 5, 2025.
    73 changes: 73 additions & 0 deletions ExtractItemNumbers.xlsm
    View file
    Original file line number Diff line number Diff line change
    @@ -0,0 +1,73 @@
    ' Require 4sgm item numbers on column A
    ' Require URL with 100 per page parameter
    ' Enter URL when prompted


    Sub ExtractItemNumbers()
    Dim ie As Object
    Dim html As Object
    Dim skuElements As Object
    Dim skuElement As Object
    Dim ws As Worksheet
    Dim i As Integer
    Dim userURL As String
    Dim itemNumber As String

    ' Prompt the user to enter the URL
    userURL = InputBox("Please enter the URL of the webpage to parse:", "Enter URL")

    ' Check if the user provided a URL
    If userURL = "" Then
    MsgBox "No URL provided. Exiting macro.", vbExclamation
    Exit Sub
    End If

    ' Create InternetExplorer object
    Set ie = CreateObject("InternetExplorer.Application")
    ie.Visible = False ' Set to True if you want to see the browser

    ' Navigate to the user-provided webpage
    ie.navigate userURL

    ' Wait for the page to fully load
    Do While ie.Busy Or ie.readyState <> 4
    DoEvents
    Loop

    ' Get the HTML document
    Set html = ie.document

    ' Find all elements with the class name "sku"
    Set skuElements = html.getElementsByClassName("sku")

    ' Check if any elements were found
    If skuElements.Length = 0 Then
    MsgBox "No elements with the class name 'sku' found. Exiting macro.", vbExclamation
    ie.Quit
    Set ie = Nothing
    Set html = Nothing
    Exit Sub
    End If

    ' Create a new worksheet for the results
    Set ws = ThisWorkbook.Sheets.Add
    ws.Name = "Item Numbers"
    ws.Cells(1, 1).Value = "Item Number"

    ' Loop through the elements and extract the item numbers
    i = 2
    For Each skuElement In skuElements
    ' Get the inner text and remove the "Item#: " prefix
    itemNumber = Replace(skuElement.innerText, "Item#: ", "")
    ws.Cells(i, 1).Value = itemNumber
    i = i + 1
    Next skuElement

    ' Clean up
    ie.Quit
    Set ie = Nothing
    Set html = Nothing

    MsgBox "Item numbers have been extracted successfully!", vbInformation
    End Sub