CODEWITHSUNDEEP
excelexcel-formula
Rafi
Rafi

Reputation: 49

Web Query from URL in Cell

I believe I have thoroughly researched this question (sorry if you have seen the answer, please be patient with me).

Truly a newcomer to VBA/Macros and do not even fully understand where to "put" the codes that are provided in these message boards, that is why I prefer a formula.

My sheet has cells which feed to a hyperlink (i.e. A1=JFK, B1:CVG, C1=HYPERLINK("http://www.gcmap.com/dist?p="&A1&"-"&B1,"My Flight").

If you visit the link (http://www.gcmap.com/dist?P=jfk-cvg) it shows the flying distance between these two points - 589 mi.

What I am trying to do is do a web query in Excel based off the link provided in cell C1, and then have the web query point to the total distance included in the link - and then populate another cell on my sheet (D1) with that distance.

Any and all help would be appreciated!

Upvotes: 0

Views: 1969

Answers (1)

BruceWayne
BruceWayne

Reputation: 23283

How's something like this:

 Sub getMiles()
 'Thanks to http://stackoverflow.com/questions/16975506/how-to-download-source-code-from-a-website-with-vba for idea
Dim k As Long, s
Dim URL2          As String
Dim ws As Worksheet, newWS As Worksheet

Set ws = ActiveSheet


Application.ScreenUpdating = False
URL2 = ws.Cells(1, 3) 'Cell C1 is the URL

' to get data from the url we need to creat a win Http object_
' tools > references > select Windows Win Http Services 5.1
Dim Http2         As New WinHttpRequest
'open the url
Http2.Open "GET", URL2, False

' send request
Http2.Send
'MsgBox Http2.ResponseText
Debug.Print s
'Debug.Print Http2
Debug.Print URL2
Dim Resp          As String: Resp = Http2.ResponseText
Dim Lines2        As Variant: Lines2 = Split(Resp, ">")

Worksheets.Add after:=Sheets(Sheets.Count)
Set newWS = ActiveSheet
newWS.Name = "Temp for source code"

k = 0
For k = LBound(Lines2) To UBound(Lines2)
    newWS.Cells(1 + k, 1).Value = Lines2(k)
    k = k + 1
Next k



Dim findString As String, stringCell As Range
findString = " mi"
Set stringCell = newWS.Columns(1).Find(what:=findString)

Dim milesFlown    As String
milesFlown = Left(stringCell.Value, WorksheetFunction.Search("&", stringCell, 1) - 1)

'MsgBox ("You would fly " & milesFlown)
ws.Cells(1, 4).Value = milesFlown

Application.DisplayAlerts = False
newWS.Delete
Application.DisplayAlerts = True
Application.ScreenUpdating = True

End Sub

It's sort of roundabout, but what it does is get the source code of your URL, and in that source code, look for a string that only seems to occur before the miles are given (" mi"), then finds the numbers to the left of the &, and sets that as your miles. You will need to tweak the macro to correctly point to the cell with your URL. Let me know if you need any help doing so!

edit: Ah, to use this code, with Excel open, press ALT+F11, this will open up the VB editor. I think you can insert this code (just copy/paste) into the "Sheet1 (Sheet1)" part. If not, you'll need to right click "VBAProject ([yourbook])" and Insert Module, and put the code there. It should then show up in your macro list (View tab --> Macros).

Edit2: Also, you'll need to add a Reference most likely in VBA. Press ALT+F1 to open VB Editor, then in Tools -> References, look for "Microsoft WinHTTP Services, version 5.1" and add a check mark, and click "Ok" to add this reference. Otherwise, you'll get an error.

Edit3: Updated the code. It now puts the source code on a new sheet, so anything you have in Col. A won't be deleted.

Upvotes: 1

Related Questions