none
Error retrieving hyperlink address RRS feed

  • Question

  • Hi I have an excel spreadsheet that has an inventory list. In the first column of cells each cell has an embedded hyperlink, that takes me to the item on the web. that hyper link contains an item number that I want to retrieve and add to the spreadsheet.

    I am using Visual Basic 6.0 on Windows XP

    Microsoft excel 2000

    Google chrome browser

    her is my code 

        Dim tstString, YoYooNum
        Dim RowCnt, rw, nextrow, J, tst1, tst2 As Integer
        Set xlApp = New Excel.Application
        Set xlbook = xlApp.Workbooks.Open("F:\Pricelist.xls")
        Set xlsheet = xlbook.Worksheets(cmbYONumber.Text)
        xlsheet.Activate
        xlApp.Visible = True
        Range("A3").Select
        Selection.End(xlDown).Select
        RowCnt = ActiveCell.Row + 1
        For J = 3 To RowCnt
            Range("A" & J).Select
            tstString = Selection.Hyperlinks(1).Address
            tst1 = InStr(tstString, "=")
            tst2 = InStr(tstString, "&shbid")
            YoYooNum = Mid$(tstString, tst1 + 1, tst2 - (tst1 + 1))
            Cells(J, 3).Value = YoYooNum
            'tstString = Null
        Next
        xlApp.Workbooks.Close
        xlApp.Quit

    This works fine for 7 trips through the loop but then generates the following error

    "Subscript out of range"    error on the following line

    tstString = Selection.Hyperlinks(1).Address


    • Edited by bigdaddy1959 Wednesday, December 5, 2012 6:49 PM missing info
    Wednesday, December 5, 2012 6:44 PM

Answers

  • Sorry, my bad, try:

    Dim tstString, YoYooNum
    Dim RowCnt, rw, nextrow, J, tst1, tst2 As Integer
    Dim Rng as range
        Set xlApp = New Excel.Application
        Set xlbook = xlApp.Workbooks.Open("F:\Gemmark Pricelist.xls")
        Set xlsheet = xlbook.Worksheets(cmbYONumber.Text)
        xlsheet.Activate
        xlApp.Visible = True
        for each Rng in Range("A3", Range("A3").End(xlDown))
            tstString = ""
            If Rng.Hyperlinks.Count > 0 Then
                tstString = rng.Hyperlinks(1).Address
                tst1 = InStr(tstString, "=")
                tst2 = InStr(tstString, "&shbid")
                YoYooNum = Mid$(tstString, tst1 + 1, tst2 - (tst1 + 1))
                rng.range("C1").Value = YoYooNum
            End If
        Next Rng
        xlApp.Workbooks.Close
        xlApp.Quit



    Rod Gill

    The one and only Project VBA Book

    Rod Gill Project Management

    • Marked as answer by bigdaddy1959 Friday, December 7, 2012 4:09 PM
    Thursday, December 6, 2012 2:05 AM

All replies

  • Try:


    If ActiveCell.hyperlinks.count>0 then

    tstString = ActiveCell.Hyperlinks(1).Address tst1 = InStr(tstString, "=") tst2 = InStr(tstString, "&shbid") YoYooNum = Mid$(tstString, tst1 + 1, tst2 - (tst1 + 1)) Cells(J, 3).Value = YoYooNu

    End If



    Rod Gill

    The one and only Project VBA Book

    Rod Gill Project Management

    Wednesday, December 5, 2012 8:14 PM
  • Thank you very much, now I see why it was failing, I had cells with no hyperlinks in them.

    Once again, thank you for your assistance

    BigDaddy1959

    (Mark)

    Wednesday, December 5, 2012 9:23 PM
  • Hi the above that you recommended fixed the subscript erroe but another problem has surfaced

    Thethe number extracted from the hyperlink is the same even though the number in the hyperlink for each row is unique. I tried adding the following precedeing tthe line that asigns the new value

    tstString = ""

    see code below

        Dim tstString, YoYooNum
        Dim RowCnt, rw, nextrow, J, tst1, tst2 As Integer
        Set xlApp = New Excel.Application
        Set xlbook = xlApp.Workbooks.Open("F:\Gemmark Pricelist.xls")
        Set xlsheet = xlbook.Worksheets(cmbYONumber.Text)
        xlsheet.Activate
        xlApp.Visible = True
        Range("A3").Select
        Selection.End(xlDown).Select
        RowCnt = ActiveCell.Row + 1
        For J = 3 To RowCnt
            Range("A" & J).Select
            tstString = ""
            If ActiveCell.Hyperlinks.Count > 0 Then
                tstString = ActiveCell.Hyperlinks(1).Address
                tst1 = InStr(tstString, "=")
                tst2 = InStr(tstString, "&shbid")
                YoYooNum = Mid$(tstString, tst1 + 1, tst2 - (tst1 + 1))
                Cells(J, 3).Value = YoYooNum
            End If
        Next
        xlApp.Workbooks.Close
        xlApp.Quit

    Wednesday, December 5, 2012 9:52 PM
  • Sorry, my bad, try:

    Dim tstString, YoYooNum
    Dim RowCnt, rw, nextrow, J, tst1, tst2 As Integer
    Dim Rng as range
        Set xlApp = New Excel.Application
        Set xlbook = xlApp.Workbooks.Open("F:\Gemmark Pricelist.xls")
        Set xlsheet = xlbook.Worksheets(cmbYONumber.Text)
        xlsheet.Activate
        xlApp.Visible = True
        for each Rng in Range("A3", Range("A3").End(xlDown))
            tstString = ""
            If Rng.Hyperlinks.Count > 0 Then
                tstString = rng.Hyperlinks(1).Address
                tst1 = InStr(tstString, "=")
                tst2 = InStr(tstString, "&shbid")
                YoYooNum = Mid$(tstString, tst1 + 1, tst2 - (tst1 + 1))
                rng.range("C1").Value = YoYooNum
            End If
        Next Rng
        xlApp.Workbooks.Close
        xlApp.Quit



    Rod Gill

    The one and only Project VBA Book

    Rod Gill Project Management

    • Marked as answer by bigdaddy1959 Friday, December 7, 2012 4:09 PM
    Thursday, December 6, 2012 2:05 AM
  • thanks again for you assistance works great
    Friday, December 7, 2012 4:08 PM