change_hyperlinks.vbs

' 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