Quote Originally Posted by YellowLabPro
What I ultimately would like to do is provide a list of desired items and find size, spec information and descriptions, retrieving pictures might actually be very helpful too.
Consider this the final cut. XML recordsets don't generate much interest in this forum, so I wrote a sub to parse data into an Access Table, and included pictures. I have attached the zipped .mdb with 1 row (the first snowboard) as the entire file is ~1.8 meg. The following sub will open the table and create an excel worksheet based on the info in the data. You will note I made a comment about using the clipboard for two fields since it would parse the data into separate rows instead of a text block... but consider that homework.

If this is in the ballpark of the type of output you want, I will post the sub to create the table for all snowboards. Again, this is just my method for web-scraping - collect all links.images and detail in a database and generate worksheets locally as needed. Make sure you unzip the .mdb and place it in the same subdir as the excel file you put the code into.

Stan


[vba]
Sub createitem()
cPath = ActiveWorkbook.Path
cMDB = cPath & "\wtest.mdb"
If Dir(cMDB) = "" Then Exit Sub
cProv = "MicroSoft.Jet.OLEDB.4.0"
cConn = "Provider=" & cProv & ";Data Source=" & cMDB & ";"
Set oRS = CreateObject("Adodb.Recordset")
oRS.Open "Items", cConn, 1, 3, 2
oRS.MoveFirst
nOld = Application.SheetsInNewWorkbook
Application.SheetsInNewWorkbook = 1
Application.Workbooks.Add
Application.SheetsInNewWorkbook = nOld
Set oWS = Application.ActiveWorkbook.Worksheets(1)
cName = oRS.Collect("Item")
If Len(cName) > 30 Then cName = Mid(cName, 1, 30)
oWS.Name = cName
oWS.Activate
Application.ActiveWindow.DisplayGridlines = False
oWS.Range("A1").Value = oRS.Collect("Item")
oWS.Range("A2").Value = oRS.Collect("Price")
'with these next 2 it would be better to copy
'the field data to the clipboard then paste
'to the range.
oWS.Range("A4").Value = oRS.Collect("Details")
oWS.Range("A16").Value = oRS.Collect("Descrip")
oWS.Columns("A:A").Select
Application.Selection.ColumnWidth = 54.14
Application.Selection.WrapText = True
Set oS = CreateObject("ADODB.Stream")
oS.Type = 1
oS.Open
oS.Write (oRS.Collect("img"))
oS.Position = 0
cPict = cPath & "\" & "test.jpg"
oS.SaveToFile cPict, 2
oS.Close
oS = 0
oWS.Range("C1").Select
oWS.Pictures.Insert(cPict).Select
Application.ScreenUpdating = 1
Set oWS = Nothing
oRS.Close
Set oRS = Nothing
End Sub
[/vba]