Hi;
Wondered if someone would help me make this work, and/or simplify.
Trying to convert all inserted/hyperlinks automatically to '=Hyperlin
Formulas', using the existing hyperlink-VALUE (NOT the address whic
are scr... up (relative paths horror)).

Any chance of tweaking this code to make it fly ?
Also, what should I put in the function name's parentheses?
Thanks.



Function FunctionCreateHLFormula()

Option Explicit

Dim MyPath As String
Dim HL As Hyperlink
Dim sh As Worksheet
Dim Currfile As String
Dim CurrWb As Workbook
Dim xlink As String
Dim cell As Range


On error goto FuncFail:

'Change this path to where the workbooks are
MyPath = "C:\Temp\Temp4\"

'Find the first xls file in the directory
Currfile = Dir(MyPath & "*.xls")


'Do while there is at least one xls file
Do While Currfile < ""
'Open the file
Set CurrWb = Workbooks.Open(MyPath & Currfile)
'Cycle through the sheets
For Each sh In CurrWb.Worksheets
'Cycle through the hyperlinks on the sheet
For Each HL In sh.Hyperlinks
'
xlink = cell.Value
cell.HL.Delete
cell.Formula = "=HYPERLINK(""" & xlink & """,""" & xlink & """)

'Mostly to open docs, pics on network shares
Next HL
Next sh
'Close the workbook
CurrWb.Close False
'Find the next xls file
Currfile = Dir
Loop


Set CurrWb = Nothing
Set sh = Nothing
Set HL = Nothing


End Sub


FuncFail:
MyPath=CvErr(xlErrValue)
HL=CvErr(xlErrValue)
sh=CvErr(xlErrValue)
Currfile=CvErr(xlErrValue)
Currwb=CvErr(xlErrValue)
xlink=CvErr(xlErrValue)
cell.Formula=CvErr(xlErrValue)
cell.value=CvErr(xlErrValue)

End Functio

--
Electro91
-----------------------------------------------------------------------
Electro911's Profile: http://www.excelforum.com/member.php...fo&userid=3194
View this thread: http://www.excelforum.com/showthread.php?threadid=51708