Hello all,

I'm trying to run the following macro but I get an error as given in
the subject line. Please help me to fix the error.

I'm trying to check if the hyperlinks in several cells of a column are
working or dead. Given below is not my code but I found it in the
internet and it suited what I'm trying to do.

Thanks,
Marvin.


Option Explicit

Sub CheckHyperlinks()

Dim oColumn As Range
Set oColumn = GetColumn() ' replace this with code to get the
relevant column

Dim oCell As Range
For Each oCell In oColumn.Cells

If oCell.Hyperlinks.Count 0 Then

Dim oHyperlink As Hyperlink
Set oHyperlink = oCell.Hyperlinks(1) ' I assume only 1
hyperlink per cell

Dim strResult As String
strResult = GetResult(oHyperlink.Address)

oCell.Offset(0, 1).Value = strResult

End If
If Trim(oCell.Value) < "" Then
oCell.Offset(0, 1).Value = GetResult(oCell.Value)
End If

Next oCell


End Sub

Private Function GetResult(ByVal strUrl As String) As String

On Error GoTo ErrorHandler

Dim oHttp As New MSXML2.XMLHTTP30

oHttp.Open "HEAD", strUrl, False
oHttp.send

GetResult = oHttp.Status & " " & oHttp.statusText

Exit Function

ErrorHandler:
GetResult = "Error: " & Err.Description

End Function

Private Function GetColumn() As Range
Set GetColumn = ActiveWorkbook.Worksheets(1).Range("A:A")
End Function

Private Sub CommandButton1_Click()
Call CheckHyperlinks
End Sub

Works for me - using a slightly different version (MSXML2.XMLHTTP26)
since I don't have your version

What is the value of strUrl when you get the error? The url must have
the protocol as part of the address (ie. you need to have http://www.blahblah.com
and not just www.blahblah.com)

Tim



On Jan 23, 1:39*pm, Marvin wrote:
Hello all,

I'm trying to run the following macro but I get an error as given in
the subject line. Please help me to fix the error.

I'm trying to check if the hyperlinks in several cells of a column are
working or dead. Given below is not my code but I found it in the
internet and it suited what I'm trying to do.

Thanks,
Marvin.

Option Explicit

Sub CheckHyperlinks()

* * Dim oColumn As Range
* * Set oColumn = GetColumn() ' replace this with code to get the
relevant column

* * Dim oCell As Range
* * For Each oCell In oColumn.Cells

* * * * If oCell.Hyperlinks.Count 0 Then

* * * * * *Dim oHyperlink As Hyperlink
* * * * * * Set oHyperlink = oCell.Hyperlinks(1) ' I assume only 1
hyperlink per cell

* * * * * * Dim strResult As String
* * * * * * strResult = GetResult(oHyperlink.Address)

* * * * * * oCell.Offset(0, 1).Value = strResult

* * * * End If
*If Trim(oCell.Value) < "" Then
*oCell.Offset(0, 1).Value = GetResult(oCell.Value)
*End If

* * Next oCell

End Sub

Private Function GetResult(ByVal strUrl As String) As String

* * On Error GoTo ErrorHandler

* * Dim oHttp As New MSXML2.XMLHTTP30

* * oHttp.Open "HEAD", strUrl, False
* * oHttp.send

* * GetResult = oHttp.Status & " " & oHttp.statusText

* * Exit Function

ErrorHandler:
* * GetResult = "Error: " & Err.Description

End Function

Private Function GetColumn() As Range
* * Set GetColumn = ActiveWorkbook.Worksheets(1).Range("A:A")
End Function

Private Sub CommandButton1_Click()
Call CheckHyperlinks
End Sub

On Jan 24, 1:10*am, Tim Williams wrote:
Works for me - using a slightly different version (MSXML2.XMLHTTP26)
since I don't have your version

What is the value of strUrl when you get the error? *The url must have
the protocol as part of the address (ie. you need to havehttp://www.blahblah.com
and not justwww.blahblah.com)

Tim

On Jan 23, 1:39*pm, Marvin wrote:







Hello all,

I'm trying to run the following macro but I get an error as given in
the subject line. Please help me to fix the error.

I'm trying to check if the hyperlinks in several cells of a column are
working or dead. Given below is not my code but I found it in the
internet and it suited what I'm trying to do.

Thanks,
Marvin.

Option Explicit

Sub CheckHyperlinks()

* * Dim oColumn As Range
* * Set oColumn = GetColumn() ' replace this with code to get the
relevant column

* * Dim oCell As Range
* * For Each oCell In oColumn.Cells

* * * * If oCell.Hyperlinks.Count 0 Then

* * * * * *Dim oHyperlink As Hyperlink
* * * * * * Set oHyperlink = oCell.Hyperlinks(1) ' I assume only 1
hyperlink per cell

* * * * * * Dim strResult As String
* * * * * * strResult = GetResult(oHyperlink.Address)

* * * * * * oCell.Offset(0, 1).Value = strResult

* * * * End If
*If Trim(oCell.Value) < "" Then
*oCell.Offset(0, 1).Value = GetResult(oCell.Value)
*End If

* * Next oCell

End Sub

Private Function GetResult(ByVal strUrl As String) As String

* * On Error GoTo ErrorHandler

* * Dim oHttp As New MSXML2.XMLHTTP30

* * oHttp.Open "HEAD", strUrl, False
* * oHttp.send

* * GetResult = oHttp.Status & " " & oHttp.statusText

* * Exit Function

ErrorHandler:
* * GetResult = "Error: " & Err.Description

End Function

Private Function GetColumn() As Range
* * Set GetColumn = ActiveWorkbook.Worksheets(1).Range("A:A")
End Function

Private Sub CommandButton1_Click()
Call CheckHyperlinks
End Sub

Hello Tim,

Yes. I didn't use http:// in the hyperlinks. I used it but got another
error. Error: Access is denied. Did some quick internet search on this
and found that replacing XMLHTTP30 with ServerXMLHTTP30 solves the
problem.

This is just the beginning of what I'm trying to do and the code I
found forms a good foundation. I'll be making several tweaks in the
spare time. I will post queries as and when it pops up!

Marvin.

On Jan 24, 8:19*pm, Marvin wrote:
On Jan 24, 1:10*am, Tim Williams wrote:









Works for me - using a slightly different version (MSXML2.XMLHTTP26)
since I don't have your version

What is the value of strUrl when you get the error? *The url must have
the protocol as part of the address (ie. you need to havehttp://www.blahblah.com
and not justwww.blahblah.com)

Tim

On Jan 23, 1:39*pm, Marvin wrote:

Hello all,

I'm trying to run the following macro but I get an error as given in
the subject line. Please help me to fix the error.

I'm trying to check if the hyperlinks in several cells of a column are
working or dead. Given below is not my code but I found it in the
internet and it suited what I'm trying to do.

Thanks,
Marvin.

Option Explicit

Sub CheckHyperlinks()

* * Dim oColumn As Range
* * Set oColumn = GetColumn() ' replace this with code to get the
relevant column

* * Dim oCell As Range
* * For Each oCell In oColumn.Cells

* * * * If oCell.Hyperlinks.Count 0 Then

* * * * * *Dim oHyperlink As Hyperlink
* * * * * * Set oHyperlink = oCell.Hyperlinks(1) ' I assume only 1
hyperlink per cell

* * * * * * Dim strResult As String
* * * * * * strResult = GetResult(oHyperlink.Address)

* * * * * * oCell.Offset(0, 1).Value = strResult

* * * * End If
*If Trim(oCell.Value) < "" Then
*oCell.Offset(0, 1).Value = GetResult(oCell.Value)
*End If

* * Next oCell

End Sub

Private Function GetResult(ByVal strUrl As String) As String

* * On Error GoTo ErrorHandler

* * Dim oHttp As New MSXML2.XMLHTTP30

* * oHttp.Open "HEAD", strUrl, False
* * oHttp.send

* * GetResult = oHttp.Status & " " & oHttp.statusText

* * Exit Function

ErrorHandler:
* * GetResult = "Error: " & Err.Description

End Function

Private Function GetColumn() As Range
* * Set GetColumn = ActiveWorkbook.Worksheets(1).Range("A:A")
End Function

Private Sub CommandButton1_Click()
Call CheckHyperlinks
End Sub

Hello Tim,

Yes. I didn't use http:// in the hyperlinks. I used it but got another
error. Error: Access is denied. Did some quick internet search on this
and found that replacing XMLHTTP30 with ServerXMLHTTP30 solves the
problem.

This is just the beginning of what I'm trying to do and the code I
found forms a good foundation. I'll be making several tweaks in the
spare time. I will post queries as and when it pops up!

Marvin.

Hello Tim and Group,

I just realized that the spreadsheet also contains files hyperlinked
to network drives also.
Format is something like: \
\global1\folder1\folder2\folder3\folder4\test.xls

If that link doesn't work, then how to tweak the macro to find this
broken link?

Please can someone shed some light on this.

Thanks,
Marvin

On Jan 26, 9:46*pm, Marvin wrote:
On Jan 24, 8:19*pm, Marvin wrote:









On Jan 24, 1:10*am, Tim Williams wrote:

Works for me - using a slightly different version (MSXML2.XMLHTTP26)
since I don't have your version

What is the value of strUrl when you get the error? *The url must have
the protocol as part of the address (ie. you need to havehttp://www.blahblah.com
and not justwww.blahblah.com)

Tim

On Jan 23, 1:39*pm, Marvin wrote:

Hello all,

I'm trying to run the following macro but I get an error as given in
the subject line. Please help me to fix the error.

I'm trying to check if the hyperlinks in several cells of a column are
working or dead. Given below is not my code but I found it in the
internet and it suited what I'm trying to do.

Thanks,
Marvin.

Option Explicit

Sub CheckHyperlinks()

* * Dim oColumn As Range
* * Set oColumn = GetColumn() ' replace this with code to get the
relevant column

* * Dim oCell As Range
* * For Each oCell In oColumn.Cells

* * * * If oCell.Hyperlinks.Count 0 Then

* * * * * *Dim oHyperlink As Hyperlink
* * * * * * Set oHyperlink = oCell.Hyperlinks(1) ' I assume only 1
hyperlink per cell

* * * * * * Dim strResult As String
* * * * * * strResult = GetResult(oHyperlink.Address)

* * * * * * oCell.Offset(0, 1).Value = strResult

* * * * End If
*If Trim(oCell.Value) < "" Then
*oCell.Offset(0, 1).Value = GetResult(oCell.Value)
*End If

* * Next oCell

End Sub

Private Function GetResult(ByVal strUrl As String) As String

* * On Error GoTo ErrorHandler

* * Dim oHttp As New MSXML2.XMLHTTP30

* * oHttp.Open "HEAD", strUrl, False
* * oHttp.send

* * GetResult = oHttp.Status & " " & oHttp.statusText

* * Exit Function

ErrorHandler:
* * GetResult = "Error: " & Err.Description

End Function

Private Function GetColumn() As Range
* * Set GetColumn = ActiveWorkbook.Worksheets(1).Range("A:A")
End Function

Private Sub CommandButton1_Click()
Call CheckHyperlinks
End Sub

Hello Tim,

Yes. I didn't use http:// in the hyperlinks. I used it but got another
error. Error: Access is denied. Did some quick internet search on this
and found that replacing XMLHTTP30 with ServerXMLHTTP30 solves the
problem.

This is just the beginning of what I'm trying to do and the code I
found forms a good foundation. I'll be making several tweaks in the
spare time. I will post queries as and when it pops up!

Marvin.

Hello Tim and Group,

I just realized that the spreadsheet also contains files hyperlinked
tonetworkdrives also.
Format is something like: \
\global1\folder1\folder2\folder3\folder4\test.xls

If thatlinkdoesn't work, then how to tweak the macro to find thisbrokenlink?

Please can someone shed some light on this.

Thanks,
Marvin

Guys,

Please help on my previous request. I'm struggling...