Thread: hyperlinks

Hi,

I have a worksheet with hundrets of hyperlinks in column A. these hyperlinks are leading to web pages that have the same structure, but different details.
what I need to make is a macro that enter the link, copies particular details to separate workshhet, then copies 2 particuar cells (which are always in the same place) and paste it to column B and C, in the same row as the hyperlink.
then goes to next link...., and till the end of my list.

sorry for my english. if something is not clear, pls ask

What have you got so far ?
Please post a sample workbook to clarify your question.

hi afgi

does this help ..

Option Explicit
Sub test()
Dim hLink As Object
For Each hLink In Worksheets(1).Hyperlinks
    Debug.Print hLink.Name
Next
End Sub

hi,

pls find the excel table attached.
1. column A contains a link to the auction
2. column B contains URL

3. column C - I want it to contain name of the auction
4. column D - I want this to have price of the auction

so, as I presume, it has to go to specific web page, copy it to separate worksheet, and then copy particular cells to columns C and D in particular rows.

I have this VBA code, but this is far from what I want and this is not a loop one. I need modification to make it a loop makro and that will extract requred data to all of rows with hyperlinks

Sub test()
'
' test Makro
'

'
    Range("B2").Select
    ActiveCell.FormulaR1C1 = "http://moda.allegro.pl/1219836365-i1219836365.html"
    With ActiveCell.Characters(Start:=1, Length:=50).Font
        .Name = "Arial Unicode MS"
        .FontStyle = "Normalny"
        .Size = 10
        .Strikethrough = False
        .Superscript = False
        .Subscript = False
        .OutlineFont = False
        .Shadow = False
        .Underline = xlUnderlineStyleSingle
        .ThemeColor = xlThemeColorLight1
        .TintAndShade = 0
        .ThemeFont = xlThemeFontNone
    End With
    Sheets("aaaaaa").Select
    With ActiveSheet.QueryTables.Add(Connection:= _
        "URL;http://moda.allegro.pl/1219836365-i1219836365.html", Destination:=Range( _
        "$A$1"))
        .Name = "1219836365-i1219836365"
        .FieldNames = True
        .RowNumbers = False
        .FillAdjacentFormulas = False
        .PreserveFormatting = True
        .RefreshOnFileOpen = False
        .BackgroundQuery = True
        .RefreshStyle = xlInsertDeleteCells
        .SavePassword = False
        .SaveData = True
        .AdjustColumnWidth = True
        .RefreshPeriod = 0
        .WebSelectionType = xlSpecifiedTables
        .WebFormatting = xlWebFormattingNone
        .WebTables = "1,3"
        .WebPreFormattedTextToColumns = True
        .WebConsecutiveDelimitersAsOne = True
        .WebSingleBlockTextImport = False
        .WebDisableDateRecognition = False
        .WebDisableRedirections = False
        .Refresh BackgroundQuery:=False
    End With
    Range("C1").Select
    Selection.Copy
    Sheets("links").Select
    Range("C2").Select
    ActiveSheet.Paste
    Sheets("aaaaaa").Select
    Range("B7").Select
    Application.CutCopyMode = False
    Selection.Copy
    Sheets("links").Select
    Range("D2").Select
    ActiveSheet.Paste
End Sub

hi afgi

try this ... problem is I cant read what is meant to be the price or name but you will get the idea

Sub Port()
   Dim sht1 As Worksheet
   Dim qryTbl As QueryTable
   Dim XRow As Variant

   Set sht1 = ThisWorkbook.Worksheets("Here")

   For Each XRow In Range("B2:B6")
    Nrow = XRow.Address
   Set qryTbl = sht1.QueryTables.Add(Connection:="URL;" & XRow, _
   Destination:=sht1.Range("A1"))

   With qryTbl
       .BackgroundQuery = True
       .WebSelectionType = xlSpecifiedTables
       .WebTables = "2"
       .WebFormatting = xlWebFormattingAll
       .Refresh BackgroundQuery:=False
       .SaveData = True
   End With
  
   With sht1
      .Range("B2").Copy Destination:=Sheets("links").Range(Nrow).Offset(0, 1)
   .Range("B3").Copy Destination:=Sheets("links").Range(Nrow).Offset(0, 2)
   End With
Next XRow
End Sub

Hi afgi,
try this workbook.. I may have changed something to your original

Hi,

and of course I still do not get why it works onl on your worksheet...

hi afgi
You will always have problems when importing from the web as Table values depending on the address/layer cange and sites also change. I think the problem was I changed the sheet name from "aaaaaa" to "Here"
to find the correct table you have to read the source code

Thats good I forgot to add that you nedd this bit

  For Each XRow In Range("B2", Cells(Rows.Count, 2).End(xlUp))

so it works for the dynamic range