Moving OLE/XLINK and HyperLinks to a new NAS
 

hi all

Does anyone know how I can resolve this issue ... I have a NAS (FILER) which
over 5000 !!!worksheets which have links to external data (Shares, UNC and
also Hyperlinks)

-- I need to copy these files into a New NAS, If
I do a simple Cut & Past, the Reference Link to the Spreadsheet gets
moved to the New Directory (where the file does not exist), but if I open
the worksheet (in the original directory/location) and Save As to the New
Directory, the worksheet saved in the New Directory maintains its link to
the Master Spreadsheet in the original directory/location. I hope I've
explained this clearly.

Here's my problem -- it's a bit time consuming to have to open each and
every worksheet and Save As to the New Location -- I'm not sure if a VB /
VBS or Batch
File (or Dos Command xcopy) would solve this --

Is there some code I could use to Open each worksheet search for the old NAS
and replace it with the new NAS Share ?

Many Thanks in Advance.

this is the code to show the links



ttribute VB_Name = "Module1"
Option Explicit

Public Sub main()
Dim objExcel As Object ' Excel.Application
Dim objWork As Object ' Excel.Workbook
Dim objSheet As Object ' Excel.Worksheet
Dim objHyperlink As Object ' Excel.Hyperlink
Dim aLinks As Variant
Dim intC1 As Integer
Dim intSheetIndex As Integer

Set objExcel = CreateObject("Excel.Application")
objExcel.DisplayAlerts = False
Set objWork = objExcel.Workbooks.Open(FileName:="c:\test\swfeb02 .xls",
UpdateLinks:=0, IgnoreReadOnlyRecommended:=True)
aLinks = objWork.LinkSources(xlExcelLinks)
If Not IsEmpty(aLinks) Then
For intC1 = 1 To UBound(aLinks)
Debug.Print "XLLINK:" & aLinks(intC1)
Next
End If
aLinks = objWork.LinkSources(xlOLELinks)
If Not IsEmpty(aLinks) Then
For intC1 = 1 To UBound(aLinks)
Debug.Print "OLELINK:" & aLinks(intC1)
Next
End If
For Each objSheet In objWork.Worksheets
For Each objHyperlink In objSheet.Hyperlinks
Debug.Print "HYPERLINK:" & objHyperlink.Address
Next
Next
objExcel.DisplayAlerts = False
objWork.Close savechanges:=False

End Sub

cheers

klaus

Moving OLE/XLINK and HyperLinks to a new NAS
 

additional Information

I know the ChangeLink Functions but it looks like the functions does not
really work
has anybody a workaround ? (Google Search show a many many problems)

regards
klaus



"Klaus Bilger" schrieb im Newsbeitrag
...
hi all

Does anyone know how I can resolve this issue ... I have a NAS (FILER)
which
over 5000 !!!worksheets which have links to external data (Shares, UNC and
also Hyperlinks)

-- I need to copy these files into a New NAS, If
I do a simple Cut & Past, the Reference Link to the Spreadsheet gets
moved to the New Directory (where the file does not exist), but if I open
the worksheet (in the original directory/location) and Save As to the New
Directory, the worksheet saved in the New Directory maintains its link to
the Master Spreadsheet in the original directory/location. I hope I've
explained this clearly.

Here's my problem -- it's a bit time consuming to have to open each and
every worksheet and Save As to the New Location -- I'm not sure if a VB /
VBS or Batch
File (or Dos Command xcopy) would solve this --

Is there some code I could use to Open each worksheet search for the old
NAS and replace it with the new NAS Share ?

Many Thanks in Advance.

this is the code to show the links



ttribute VB_Name = "Module1"
Option Explicit

Public Sub main()
Dim objExcel As Object ' Excel.Application
Dim objWork As Object ' Excel.Workbook
Dim objSheet As Object ' Excel.Worksheet
Dim objHyperlink As Object ' Excel.Hyperlink
Dim aLinks As Variant
Dim intC1 As Integer
Dim intSheetIndex As Integer

Set objExcel = CreateObject("Excel.Application")
objExcel.DisplayAlerts = False
Set objWork = objExcel.Workbooks.Open(FileName:="c:\test\swfeb02 .xls",
UpdateLinks:=0, IgnoreReadOnlyRecommended:=True)
aLinks = objWork.LinkSources(xlExcelLinks)
If Not IsEmpty(aLinks) Then
For intC1 = 1 To UBound(aLinks)
Debug.Print "XLLINK:" & aLinks(intC1)
Next
End If
aLinks = objWork.LinkSources(xlOLELinks)
If Not IsEmpty(aLinks) Then
For intC1 = 1 To UBound(aLinks)
Debug.Print "OLELINK:" & aLinks(intC1)
Next
End If
For Each objSheet In objWork.Worksheets
For Each objHyperlink In objSheet.Hyperlinks
Debug.Print "HYPERLINK:" & objHyperlink.Address
Next
Next
objExcel.DisplayAlerts = False
objWork.Close savechanges:=False

End Sub

cheers

klaus