looping thru URL

Collapse
X
 
  • Time
  • Show
Clear All
new posts
  • lasilva
    New Member
    • Sep 2012
    • 2

    looping thru URL

    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.
    Attached Files
  • TheSmileyCoder
    Recognized Expert Moderator Top Contributor
    • Dec 2009
    • 2322

    #2
    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.

    Comment

    • lasilva
      New Member
      • Sep 2012
      • 2

      #3
      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 right

      Comment

      • TheSmileyCoder
        Recognized Expert Moderator Top Contributor
        • Dec 2009
        • 2322

        #4
        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 VBA

        Comment

        • zmbd
          Recognized Expert Moderator Expert
          • Mar 2012
          • 5501

          #5
          When you say the data isn't posting correctly, what do you mean... please give us an example.
          Are you getting any errors? If so, what number and description?

          -z
          Last edited by zmbd; Sep 15 '12, 06:24 AM.

          Comment

          • Guido Geurs
            Recognized Expert Contributor
            • Oct 2009
            • 767

            #6
            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 Files

            Comment

            Working...