' change_hyperlinks.vbs
' Written by Carol Wapshere
'
' Change hyperlinks in a list of Excel documents as specified in a csv file.
' The csv must have the following columns:
' path;worksheet;link text;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-hyperlinks.csv"
Const LOG_FILE = "C:\ExcelLinks\x_hyperlinks.log"
Dim arrFind(1)
Dim arrReplace(1)
arrFind(0) = "\\OLD_SERVER"
arrReplace(0) = "\\NEW_SERVER"
arrFind(1) = "X:\"
arrReplace(1) = "P:\"
Dim objFS, objList, objExcel, objWorkbook, objWorksheet, objLog
Dim strLine, path, worksheet
Dim arrItems, arrPath
Dim LinkText, newLinkText, 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
objExcel.DisplayAlerts = true
On Error Resume Next
bKeepFileOpen = false
bEOF = false
strLine = objList.Readline
strLine = objList.Readline
Do Until bEOF
arrItems = Split(strLine,";")
path = arrItems(0)
worksheet = arrItems(1)
LinkText = arrItems(2)
LinkAddress = arrItems(3)
NewLinkText = ""
NewLinkAddress = ""
If objFS.FileExists(path) Then
For i = 0 to Ubound(arrFind)
If Instr(UCase(LinkAddress), UCase(arrFind(i))) > 0 Then
NewLinkAddress = Replace(LinkAddress, arrFind(i), arrReplace(i),1,1,1)
End If
If Instr(LinkText, arrFind(i)) > 0 Then
NewLinkText = Replace(LinkText, arrFind(i), arrReplace(i),1,1,1)
End If
Exit For
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
wscript.echo worksheet
set objWorksheet = objWorkbook.Worksheets(worksheet)
For Each link in objWorksheet.Hyperlinks
If link.Address = LinkAddress Then
wscript.echo LinkAddress
objLog.Writeline "Changing link: " & LinkAddress
objLog.Writeline "New link address: " & NewLinkAddress
link.Address = NewLinkAddress
wscript.echo "Address is now " & link.Address
If link.Address <> NewLinkAddress Then
wscript.echo "Unable to change link"
objLog.Writeline("Error: Unable to change link")
End If
If NewLinkText <> "" Then
link.TextToDisplay = NewLinkText
objLog.Writeline "New link text: " & NewLinkText
End If
wscript.echo
objLog.Writeline ""
Exit For
End If
Next
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
