M
Mark Bodnar
I have a document that contains dozens of hyperlinks to other documents in
our network. I have written a macro to check go through the document and
check to see if the links are still valid, and if not to report the broken
links. If a link appears broken the macro attempts to Follow the hyperlink
(some links appear broken but actually are not - the fileexists and
folderexists methods don't work for some reason on some files on our network,
thus I attempt the Follow method).
When trying to open 3 PDF files, I get the message:
---------------------------------------
Opening http://(path of file)
Some files can contain viruses or otherwise be harmful to your computer. It
is important to be certain...etc...
Would you like to open this file?
---------------------------------------
Is there any way to disable this dialog box from appearing when attempting
to follow the hyperlink to a PDF file without changing any settings on my
computer?
The macro code follows below. Any help would be greatly appreciated.
Mark
Sub HyperLinkcheck()
'
' HyperLinkCheck Macro
' Macro created 10/18/2005 by SCSD BUSC
Dim objStory As Range
Dim objHlink As Hyperlink
Dim fs As Object
Dim target As String
Dim outstring As String
outstring = ""
MsgBox "Verifying Links...", vbInformation
For Each objStory In ActiveDocument.StoryRanges
For Each objHlink In objStory.Hyperlinks
StatusBar = "Checking hyperlink: " & objHlink.TextToDisplay
Set fs = CreateObject("Scripting.FileSystemObject")
target = objHlink.Address
If InStr(target, "http:") Then
target = Mid(target, 6)
End If
If fs.FileExists(target) Or fs.folderExists(target) Then
'Valid link
Else
' Make two attempts to open/close file
On Error GoTo retry1
objHlink.Follow
SendKeys "%fc", True
GoTo nxt
retry1: Resume retry1b
retry1b: On Error GoTo LinkErr
objHlink.Follow
SendKeys "%fc", True
GoTo nxt
LinkErr: Resume Err_b
Err_b: outstring = Trim(outstring) & vbCrLf & "Invalid link:" & vbTab &
objHlink.TextToDisplay & _
vbCrLf & vbTab & vbTab & objHlink.Address & " " &
objHlink.SubAddress
GoTo nxt
nxt: On Error GoTo 0
'Else
'outstring = Trim(outstring) & "No attempt to open: " &
objHlink.TextToDisplay & vbCrLf
'End If
End If
Next
Next
MsgBox "Check done", vbInformation
If outstring = "" Then
MsgBox "No invalid links", vbInformation
Else
MsgBox "Could not follow: " & vbCrLf & outstring, vbOKOnly
End If
End Sub
our network. I have written a macro to check go through the document and
check to see if the links are still valid, and if not to report the broken
links. If a link appears broken the macro attempts to Follow the hyperlink
(some links appear broken but actually are not - the fileexists and
folderexists methods don't work for some reason on some files on our network,
thus I attempt the Follow method).
When trying to open 3 PDF files, I get the message:
---------------------------------------
Opening http://(path of file)
Some files can contain viruses or otherwise be harmful to your computer. It
is important to be certain...etc...
Would you like to open this file?
---------------------------------------
Is there any way to disable this dialog box from appearing when attempting
to follow the hyperlink to a PDF file without changing any settings on my
computer?
The macro code follows below. Any help would be greatly appreciated.
Mark
Sub HyperLinkcheck()
'
' HyperLinkCheck Macro
' Macro created 10/18/2005 by SCSD BUSC
Dim objStory As Range
Dim objHlink As Hyperlink
Dim fs As Object
Dim target As String
Dim outstring As String
outstring = ""
MsgBox "Verifying Links...", vbInformation
For Each objStory In ActiveDocument.StoryRanges
For Each objHlink In objStory.Hyperlinks
StatusBar = "Checking hyperlink: " & objHlink.TextToDisplay
Set fs = CreateObject("Scripting.FileSystemObject")
target = objHlink.Address
If InStr(target, "http:") Then
target = Mid(target, 6)
End If
If fs.FileExists(target) Or fs.folderExists(target) Then
'Valid link
Else
' Make two attempts to open/close file
On Error GoTo retry1
objHlink.Follow
SendKeys "%fc", True
GoTo nxt
retry1: Resume retry1b
retry1b: On Error GoTo LinkErr
objHlink.Follow
SendKeys "%fc", True
GoTo nxt
LinkErr: Resume Err_b
Err_b: outstring = Trim(outstring) & vbCrLf & "Invalid link:" & vbTab &
objHlink.TextToDisplay & _
vbCrLf & vbTab & vbTab & objHlink.Address & " " &
objHlink.SubAddress
GoTo nxt
nxt: On Error GoTo 0
'Else
'outstring = Trim(outstring) & "No attempt to open: " &
objHlink.TextToDisplay & vbCrLf
'End If
End If
Next
Next
MsgBox "Check done", vbInformation
If outstring = "" Then
MsgBox "No invalid links", vbInformation
Else
MsgBox "Could not follow: " & vbCrLf & outstring, vbOKOnly
End If
End Sub