Excel VBA API – Absolute Hyperlink extraction issues

Home Forums Office Office XP / 2003 General Issues Excel VBA API – Absolute Hyperlink extraction issues

Viewing 1 post (of 1 total)
  • Author
    Posts
  • Avatar
    Armster
    Member
    #128452

    Basically when I run my macro the Variable “URL” comes up with this address:
    ../DWF/HHY-049-01 (Topographical Survey).dwf

    Rather than this (which is whats in the hyperlink)

    File:///\Yorkshire2globalt -technicalsites12DWFHHY-049-01 (Topographical Survey).dwf

    Any Ideas or help to make every link extract the full filepath would be greately appreciated.

    Thanks
    Dave

    My Code is below

    Quote:
    Code:

    Private Declare Function ShellExecute Lib “shell32.dll” Alias “ShellExecuteA” (ByVal hwnd As Long, ByVal lpOperation As String, ByVal lpFile As String, ByVal lpParameters As String, ByVal lpDirectory As String, ByVal nShowCmd As Long) As Long

    Private Declare Sub Sleep Lib “kernel32” (ByVal dwMilliseconds As Long)

    Option Explicit
    Option Compare Text
    Dim PrintURL As String
    Dim URL As String
    Dim hlnk As Hyperlink
    Dim Printer As String
    Dim PaperSizeA4 As String
    Dim PaperSizeA3 As String
    Dim PaperSizeA2 As String
    Dim PaperSizeA1 As String
    Dim PaperSizeA0 As String
    Dim OldPrinter As String
    Dim msg As String
    Dim SelRange As Range
    Dim Addr As String
    Dim sMyDefPrinter As String
    Dim myRegKey As String
    Dim myValue As String
    Dim myAnswer As Integer
    Dim strProgram As String

    Private Sub UserForm_Initialize()

    PaperSizeA4 = “\yorkshire2KONICA MINOLTA C350 PCL5c”
    PaperSizeA3 = “\yorkshire2KONICA MINOLTA C350 PCL5c A3”
    PaperSizeA2 = “\yorkshire2OCE TDS300 A2”
    PaperSizeA1 = “\yorkshire2OCE TDS300 A1”
    PaperSizeA0 = “\yorkshire2OCE TDS300”

    End Sub

    ‘ ############################ START OF PRINTING SCRIPTS ################## ###############

    Private Sub OKButton_Click()
    Dim Papersizes As String
    Dim cell As Range

    Addr = RefEdit1.Value
    myRegKey = “HKEY_CURRENT_USERSoftwareMicrosoftWindows NTCurrentVersionWindowsDevice”
    sMyDefPrinter = RegKeyRead(myRegKey)
    ‘ ##### OPENS ADOBE READER 8.0
    ‘strProgram = “C:Program FilesAdobeReader 8.0ReaderAcrord32.exe”
    ‘Call ShellExecute(vbNull, vbNull, strProgram, vbNull, vbNull, vbNull)
    ‘ ##### DWF Viewer
    ‘strProgram = “C:Program FilesAutodeskAutodesk DWF ViewerDWFViewer.exe”
    ‘Call ShellExecute(vbNull, vbNull, strProgram, vbNull, vbNull, vbNull)

    For Each hlnk In Range(Addr).Hyperlinks

    If hlnk.Range.Offset(0, 1).Text = “A4” Then

    URL = hlnk.Address
    Printer = GetPrinterKey(PaperSizeA4)
    RegKeySave myRegKey, Printer

    Call ShellExecute(0&, “print”, URL, vbNullString, vbNullString, vbNormalFocus)
    End If

    ‘ Next

    ‘ Sleep (10000)

    ‘For Each hlnk In Range(Addr).Hyperlinks
    If hlnk.Range.Offset(0, 1).Text = “A3” Then

    URL = hlnk.Address
    Printer = GetPrinterKey(PaperSizeA3)
    RegKeySave myRegKey, Printer

    Call ShellExecute(0&, “print”, URL, vbNullString, vbNullString, vbNormalFocus)
    End If
    ‘Next

    ‘ Sleep (10000)

    ‘For Each hlnk In Range(Addr).Hyperlinks

    If hlnk.Range.Offset(0, 1).Text = “A2” Then

    URL = hlnk.Address
    Printer = GetPrinterKey(PaperSizeA2)
    RegKeySave myRegKey, Printer

    Call ShellExecute(0&, “print”, URL, vbNullString, vbNullString, vbNormalFocus)
    End If

    ‘ Next

    ‘ Sleep (10000)

    ‘For Each hlnk In Range(Addr).Hyperlinks

    If hlnk.Range.Offset(0, 1).Text = “A1” Then

    URL = hlnk.Address
    Printer = GetPrinterKey(PaperSizeA1)
    RegKeySave myRegKey, Printer

    Call ShellExecute(0&, “print”, URL, vbNullString, vbNullString, vbNormalFocus)
    End If

    ‘ Next

    ‘ Sleep (12000)

    ‘ For Each hlnk In Range(Addr).Hyperlinks

    If hlnk.Range.Offset(0, 1).Text = “A0” Then

    URL = hlnk.Address
    Printer = GetPrinterKey(PaperSizeA0)
    RegKeySave myRegKey, Printer

    Call ShellExecute(0&, “print”, URL, vbNullString, vbNullString, vbNormalFocus)
    End If

    Sleep (5000)
    Next
    RegKeySave myRegKey, sMyDefPrinter

    Unload UserForm1

    End Sub

Viewing 1 post (of 1 total)

You must be logged in to reply to this topic.