I have a list of urls that i would like to keep looping thru. Every time the url is opened curtain data is scraped out then posted in correct row and columns. so far I can get my marco to loop thur the url but the data that i want is not posting coreectly. please let me know how to fix. I have attached a copy of the speadsheet for you to review.
looping thru URL
Collapse
X
-
Hi lasilva and welcome to Bytes.
Please do not take offense, but since this is your first post and I as such, do not know you, I have no intention of downloading attachments from you, and I believe that many of our experts feels the same way.
If you would care to poste the code here, indicating where you believe the problem might be, I would be happy to take a look at it for you. -
ok Here is the code I am using now
Code:Sub URL() '§ Keyboard Shortcut: Ctrl+Shift+L Dim ARRURL() As String '§ for splitting the URL Dim QT As QueryTable '§ QueryTables in sheet Dim URLDATArow As Integer Dim URLDATAitem As String Dim URLDATAdata As String Dim URLDATAitemline As Integer '§ go to first cell Range("O2").Activate '§ loop through sheet Do While ActiveCell.Value <> "" '§ split URL on "/" in array ARRURL = Split(ActiveCell.Value, "/") With ActiveSheet.QueryTables With .Add(Connection:="URL;" & ActiveCell.Value, _ Destination:=Range("URLdata")) '§ search .Name !! URL can or can NOT end on "/" If InStrRev(ActiveCell.Value, "/") = Len(ActiveCell.Value) Then .Name = ARRURL(UBound(ARRURL) - 1) Else .Name = ARRURL(UBound(ARRURL)) End If .FieldNames = True .RowNumbers = False .FillAdjacentFormulas = False .PreserveFormatting = True .RefreshOnFileOpen = False .BackgroundQuery = True .RefreshStyle = xlInsertDeleteCells .SavePassword = False .SaveData = True .AdjustColumnWidth = True .RefreshPeriod = 0 .WebSelectionType = xlEntirePage .WebFormatting = xlWebFormattingNone .WebPreFormattedTextToColumns = True .WebConsecutiveDelimitersAsOne = True .WebSingleBlockTextImport = False .WebDisableDateRecognition = False .WebDisableRedirections = False .Refresh BackgroundQuery:=False End With End With '§ clear QueryTables For Each QT In ActiveSheet.QueryTables QT.Delete Next '§ set data in cells and go 1 cell down With ActiveCell '§ move data For URLDATArow = 1 To Range("URLdata").Rows.Count URLDATAdata = Range("URLdata").Cells(URLDATArow, 2).Value If URLDATAdata <> "" Then If Range("URLdata").Cells(URLDATArow, 1).Value <> "" Then URLDATAitem = Range("URLdata").Cells(URLDATArow, 1).Value URLDATAitemline = 1 Else URLDATAitemline = URLDATAitemline + 1 End If Select Case URLDATAitem Case "displayEmail =:" Select Case URLDATAitemline Case 1 .Offset(0, 9).Value = URLDATAdata Case 2 .Offset(0, 10).Value = URLDATAdata End Select Case "<h2>:" .Offset(0, 11).Value = URLDATAdata End Select End If Next '§ go 1 cell down .Offset(1, 0).Activate End With ActiveSheet.Range("URLdata").Clear Loop End Sub
I believe it has to do with destination part of the code I dont think im doing this rightComment
-
I have looked a bit at your code, and not springs to mind as "obviously wrong", but I haven't used any code similar to yours really. I am guessing its a logic error, and I would suggest you try stepping through the code.
For more information on debugging in vba try looking at:
Debugging in VBAComment
-
The code seems to be OK but in the URL pages there is no "displayEma il =:" on which you want to capt the data from.
PS: be carefully with names: there is also a macro with the same name as the named-range: "URLdata"
I have attached a code in which you can see the data of the URLs for 5 seconds.
If you want a longer time, change the 5 to a higher value.Attached FilesComment
Comment