' change_sourcelinks.vbs
' Written by Carol Wapshere, 2008
'
' Change source links in a list of Excel documents as specified in a csv file.
' The csv must have the following columns:
' path;link address
' Set the arrFind and arrReplace values below to find and replace strings in the links.
Option Explicit
Const CHANGE_LIST = "C:\ExcelLinks\x_sourcelinks_found.csv"
Const LOG_FILE = "C:\ExcelLinks\x_change_sourcelinks.log"
Dim arrFind(3)
Dim arrReplace(3)
arrFind(0) = "\\OLD_SERVER\Share1\"
arrReplace(0) = "P:\"
arrFind(1) = "\\OLD_SERVER\Share2\"
arrReplace(1) = "Q:\"
arrFind(2) = "X:\"
arrReplace(2) = "P:\"
arrFind(3) = "Y:\"
arrReplace(3) = "Q:\"
Dim objFS, objList, objExcel, objWorkbook, objWorksheet, objLog
Dim strLine, path
Dim arrItems, arrPath
Dim LinkAddress, newLinkAddress
Dim link, i
Dim bEOF, bKeepFileOpen
set objFS = CreateObject("Scripting.FileSystemObject")
set objList = objFS.OpenTextFile(CHANGE_LIST,1)
set objLog = objFS.OpenTextFile(LOG_FILE, 8, true)
set objExcel = CreateObject("Excel.Application")
objExcel.Visible = true
bKeepFileOpen = false
bEOF = false
strLine = objList.Readline
strLine = objList.Readline
'On Error Resume Next
Do Until bEOF
 arrItems = Split(strLine,";")
 path = arrItems(0)
 LinkAddress = arrItems(1)
 NewLinkAddress = ""
 If objFS.FileExists(path) Then
   For i = 0 to Ubound(arrFind)
     If Instr(1,LinkAddress, arrFind(i), 1) > 0 Then
       wscript.echo "Change: " & LinkAddress
       NewLinkAddress = Replace(LinkAddress, arrFind(i), arrReplace(i),1,1,1)
       wscript.echo "To   : " & NewLinkAddress
       Exit For
     End If
   Next
   If NewLinkAddress <> "" Then
     'Open the Excel file
     If Not bKeepFileOpen Then
       wscript.echo path
       objLog.Writeline "File: " & path
       objExcel.DisplayAlerts = true
       set objWorkbook = objExcel.Workbooks.Open(path,0,false,,"password")
     End If
     'Change the link
     objExcel.ActiveWorkbook.ChangeLink LinkAddress, newLinkAddress
     objLog.Writeline "old link: " & LinkAddress
     objLog.Writeline "new link: " & newLinkAddress
     objLog.writeline ""
     wscript.echo
   End If
 Else
   objLog.Writeline "File not found: " & path
 End If
 'Read the next line in the CSV file
 If objList.AtEndOfStream Then
   bEOF = TRUE
 Else
   strLine = objList.Readline
 End If
 'Only close the current doc if the next one is different
 If (InStr(strLine, path) = 0) Or bEOF then
   bKeepFileOpen = FALSE
   objExcel.DisplayAlerts = true
   objExcel.ActiveWorkbook.Save
   objExcel.ActiveWorkbook.Close
 Else
   bKeepFileOpen = TRUE
 End If
Loop
objList.Close
objLog.close
objExcel.Visible = true
objExcel.DisplayAlerts = true