' 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
