' 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
    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
          objLog.Writeline ""
          Exit For
        End If
    End If
    objLog.Writeline "File not found: " & path
  End If
  'Read the next line in the CSV file
  If objList.AtEndOfStream Then
    bEOF = TRUE
    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
    bKeepFileOpen = TRUE
  End If
objExcel.Visible = true
objExcel.DisplayAlerts = true