Trent
11-18-2012, 10:50 PM
Hi all, first time poster.
Some help with the following would be appreciated. I'm working with Excel 2003 VBA on a single spreadsheet.
Basically the code below is meant to check the value in each cell in range "A:A" (beginning with A2 and running down the column) until an empty cell is reached. The values in each cell form the end of a url in which InternetExplorer adds to a base url and navigates, grabs the "characteristics" table and pastes it into the active sheet followed by a little formatting and cleaning up.
After checking the value in A2/retrieving the table/formatting... I need to understand how to move down to the next cell in "A:A" and perform the same check/navigation/retrieval etc.
If anyone could enlighten me or modify the code that would be fantastic.
Also, I currently have just over 250 values down column A in the spreadsheet which this code will check. If anyone can see a way of making the code more efficient that would be really helpful.
Thanks in advance.
Sub TempleStatGrab()
'
' TempleStatGrab Macro
' Macro recorded 19/11/2012 by
'
' Keyboard Shortcut: Ctrl+g
'
ActiveSheet.Range("A2").Select
Dim ieApp As InternetExplorer
Dim ieDoc As Object
Dim ieTable As Object
Dim clip As DataObject
Set ieApp = New InternetExplorer
ieApp.Visible = True
ieApp.navigate "****"
Do While ieApp.Busy: DoEvents: Loop
Do Until ieApp.readyState = READYSTATE_COMPLETE: DoEvents: Loop
Set ieDoc = ieApp.document
With ieDoc.forms(0)
.UserName.Value = "****"
.Password.Value = "****"
.submit
End With
Do While ieApp.Busy: DoEvents: Loop
Do Until ieApp.readyState = READYSTATE_COMPLETE: DoEvents: Loop
For Each cell In Range("A:A")
If ActiveCell.Value Is Not Empty Then
ieApp.navigate "****" & ActiveCell.Value
Do While ieApp.Busy: DoEvents: Loop
Do Until ieApp.readyState = READYSTATE_COMPLETE: DoEvents: Loop
Set ieDoc = ieApp.document
Set ieTable = ieDoc.all.Item("characteristics")
Next
If Not ieTable Is Nothing Then
Set clip = New DataObject
clip.SetText "<html>" & ieTable.outerHTML & "</html>"
clip.PutInClipboard
Sheet2.Range("D1").Select
ActiveSheet.PasteSpecial "Unicode Text"
'i'll add code here to format & place the data where it neeeds to go
End If
End Sub
Some help with the following would be appreciated. I'm working with Excel 2003 VBA on a single spreadsheet.
Basically the code below is meant to check the value in each cell in range "A:A" (beginning with A2 and running down the column) until an empty cell is reached. The values in each cell form the end of a url in which InternetExplorer adds to a base url and navigates, grabs the "characteristics" table and pastes it into the active sheet followed by a little formatting and cleaning up.
After checking the value in A2/retrieving the table/formatting... I need to understand how to move down to the next cell in "A:A" and perform the same check/navigation/retrieval etc.
If anyone could enlighten me or modify the code that would be fantastic.
Also, I currently have just over 250 values down column A in the spreadsheet which this code will check. If anyone can see a way of making the code more efficient that would be really helpful.
Thanks in advance.
Sub TempleStatGrab()
'
' TempleStatGrab Macro
' Macro recorded 19/11/2012 by
'
' Keyboard Shortcut: Ctrl+g
'
ActiveSheet.Range("A2").Select
Dim ieApp As InternetExplorer
Dim ieDoc As Object
Dim ieTable As Object
Dim clip As DataObject
Set ieApp = New InternetExplorer
ieApp.Visible = True
ieApp.navigate "****"
Do While ieApp.Busy: DoEvents: Loop
Do Until ieApp.readyState = READYSTATE_COMPLETE: DoEvents: Loop
Set ieDoc = ieApp.document
With ieDoc.forms(0)
.UserName.Value = "****"
.Password.Value = "****"
.submit
End With
Do While ieApp.Busy: DoEvents: Loop
Do Until ieApp.readyState = READYSTATE_COMPLETE: DoEvents: Loop
For Each cell In Range("A:A")
If ActiveCell.Value Is Not Empty Then
ieApp.navigate "****" & ActiveCell.Value
Do While ieApp.Busy: DoEvents: Loop
Do Until ieApp.readyState = READYSTATE_COMPLETE: DoEvents: Loop
Set ieDoc = ieApp.document
Set ieTable = ieDoc.all.Item("characteristics")
Next
If Not ieTable Is Nothing Then
Set clip = New DataObject
clip.SetText "<html>" & ieTable.outerHTML & "</html>"
clip.PutInClipboard
Sheet2.Range("D1").Select
ActiveSheet.PasteSpecial "Unicode Text"
'i'll add code here to format & place the data where it neeeds to go
End If
End Sub