Using VBA to Surf the Internet

FamousSam

New Member
Joined
Feb 10, 2004
Messages
5
Hi, I've messed about with VBA through Excel before and would like to put some code together that looks through some of my favourite web pages, looks for certain links and copies the data into an Excel ssheet. Has anyone out there got an example of code that I could use for this sort of thing? Failing that, has anyone got any recommended books that I could purchase that would concentrate on the web side of VBA? Any advice welcome!

Thanks,

Famous. Sam :eek:
 

Excel Facts

Copy formula down without changing references
If you have =SUM(F2:F49) in F50; type Alt+' in F51 to copy =SUM(F2:F49) to F51, leaving the formula in edit mode. Change SUM to COUNT.
Hullo! Well, take a look at this, but make SURE you have an "airsickness" bag handy. I write UGLY code:
Code:
Option Explicit
Sub GetContainerStatus()
Dim rngContID As Range      'the range containing the IDs
Dim rngCell As Range        'range to represent single cells
Dim rngMove As Range        'range of container numbers to move
Dim strURL As String        'Constructed URL
Dim qtData As QueryTable    'the query table
Dim LineCount As Integer    'counter for row number
Dim strDate As String       'holds move recent date
Dim rngTemp As Range        'temporary range used in date parsing
Dim Temp As Integer         'temporary counter used in date parsing
Dim strSmallID As String    'First 4 letters of ContainerID
Dim newSheet1               'Variable for sheet insertion
Dim newSheet2               'Variable for sheet insertion
Dim strResponse As String

strResponse = MsgBox("Are the web sites are working?", vbYesNo, "Web Query Readiness Check")
If strResponse = vbNo Then
    Exit Sub
End If

Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
'turn off screenupdating calculation to prevent screen flicker and speed-up code

Application.DisplayAlerts = False
Set newSheet1 = Worksheets.Add
Set newSheet2 = Worksheets.Add
newSheet1.Name = "Sandbox"
newSheet2.Name = "DataBash"
Application.DisplayAlerts = True
'insert scratch sheets

With Worksheets("Open PO status report")
    Set rngMove = .Range(.Range("G7"), .Range("G65536").End(xlUp))
End With

With rngMove
    .AdvancedFilter Action:=xlFilterCopy, CopyToRange:=Range("DataBash!A1"), unique:=True
End With
Set rngMove = Nothing

With Worksheets("DataBash")
    Set rngContID = .Range(.Range("A2"), .Range("A65535").End(xlUp))
End With
'establish the range to work with

LineCount = 2

For Each rngCell In rngContID
    'Loop through container numbers
    strURL = ParseURL(rngCell.Value)
    'establish the value in the cell and pass to the URL function
    If Left(strURL, 4) <> "http" Then GoTo Continue
    
    Set qtData = Worksheets("Sandbox").QueryTables.Add( _
            Connection:="URL;" & strURL, _
            Destination:=Worksheets("Sandbox").Range("A65536").End(xlUp).Offset(1))
    'set a reference to the querytable
    
    With qtData
        .FieldNames = True
        .BackgroundQuery = False
        .TablesOnlyFromHTML = True
        .Refresh
    End With
    
Worksheets("Sandbox").Activate
strSmallID = Left(rngCell.Value, 4)
Select Case strSmallID
    Case Is = "OOLU"
        With ActiveSheet
            Set rngTemp = .Range(.Range("B11"), .Range("B65536").End(xlUp))
        End With
        Temp = rngTemp.Rows.Count
        strDate = Range("B" & 10 + Temp - 1 & "").Value
    Case Is = "MOLU"
        strDate = Range("E19").Value
End Select

If Right(strDate, 1) = "." Or strDate = "" Then
    strDate = "No tracking for " & rngCell.Value
End If

Worksheets("DataBash").Select
Range("B" & LineCount).Value = strDate
Range("Sandbox!A1:BB3000").Delete

Continue:
Worksheets("DataBash").Select
If Range("B" & LineCount) = "" Then
    Range("B" & LineCount).Value = strURL & rngCell.Value
End If

LineCount = LineCount + 1
strDate = 0
Next rngCell

Set rngTemp = Nothing
Set rngContID = Nothing
Set rngCell = Nothing
Set qtData = Nothing
'free memory

Call PlaceDates

Application.DisplayAlerts = False
With ActiveWorkbook
.Worksheets("Sandbox").Delete
.Worksheets("DataBash").Delete
End With
Application.DisplayAlerts = True
'delete scratch sheets
Application.CutCopyMode = False
Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True
'turn screenupdating and calculation back on

End Sub

'Select statement to get correct URL header
Function ParseURL(ContainerID As String) As String
Dim CID As String

CID = Left(ContainerID, 4)
    'the abbreviated ContainerID
    
Select Case CID
    Case Is = "YMLU"
        ParseURL = "YMLU "
        'ParseURL = _
            "http://www.ymlu.com.tw/TRACK/ctconnect.asp?cntrno=" _
            & ContainerID
    Case Is = "OOLU"
        ParseURL = _
            "https://inetapp.oocl.com/ooclapp/cargo_tracking/cgo_cntr.asp?container_no=" _
            & ContainerID
    Case Is = "MAEU", "MAEC", "MAEX", "SEAU", "MAEX"
        ParseURL = "Maersk Lines. "
    Case Is = "MOLU"
        ParseURL = "http://www.mitsuiosk.com/Request/owa/CTSearch?p_keyno=" _
            & Left(ContainerID, 10) & "&p_action=Search"
    Case Else
        ParseURL = "No Tracking for "
End Select

End Function
Sub PlaceDates()
Dim rngDB1 As Range
Dim rngDB2 As Range
Dim rngOrigID As Range
Dim rngCellOID As Range
Dim Counter As Integer

Counter = 8
Application.ScreenUpdating = False

With Worksheets("DataBash")
    Set rngDB1 = .Range(.Range("A2"), .Range("B65535").End(xlUp))
End With
With Worksheets("DataBash")
    Set rngDB2 = .Range(.Range("B2"), .Range("B65535").End(xlUp))
End With
With Worksheets("Open PO status report")
    Set rngOrigID = .Range(.Range("G8"), .Range("G65535").End(xlUp))
End With

For Each rngCellOID In rngOrigID
    rngCellOID.Offset(0, 1).Value = "=index(DataBash!$A$2:$B$65535,match(G" & Counter & ",DataBash!$A$2:$A$65535,0),2)"
    Counter = Counter + 1
Next rngCellOID
rngOrigID.Offset(0, 1).Copy
With rngOrigID.Offset(0, 1)
    .PasteSpecial xlPasteValues
End With
Application.ScreenUpdating = True
End Sub

What the above barf does, is looks through a list of container numbers, goes to the shipping company's site, pulls info on the container, dumps it back to Excel, massages it, and finally puts the info in a "summary" column.

Should get you running. Or screaming. Not sure which. o_O

HTH (y)

P
 
Upvote 0

Forum statistics

Threads
1,213,546
Messages
6,114,251
Members
448,556
Latest member
peterhess2002

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top