Wednesday, August 12, 2015

VBSFindReplaceExcel

This is a script I made to find and replace server information in excel files.

The one thing this script does not search is macros


Script basics.


  • Get a path to search 
  • put path of all the excel files in variable
  • loop through the variables
  • looks to see if excel file is locked .. if it is fail this excel (this could be changed to open it based on password but we didn't need to do this)
  • looks and unlocks workbook based on list of predefined passwords if need be - records what one worked - if it was locked and none worked fail that excel file.
  • Unhide worksheets if needed
  • unlocks all worksheets if need be. - if it was locked and none worked fail that excel file.
  • loop through connections looking for servers based on an array of possibilities -  if none matched nothing changed
  • loop through objWorkbook.LinkSources to search for servers based on an array of possibilities - if none matched nothing changed
  • if nothing was changed close the excel file without saving 
  • put back worksheets to the way they were if they, either hidden or locked if needed
  • put workbook back to the way it should be.. lock it if need be.
  • save workbook since if was changed

NOTE

  • there is a read only mode
  • almost everything is logged to a text file
  • there is a default password option



On Error Resume Next
' ----------- Variable area  ---------------
' Set the variable names
Dim  objWorkbookTestExcelFilePassword, nullWBPass, replacedLinktext,aLinks, dt, objNetwork, strLocalDrive, strRemoteShare, correctPassword, needsToBeReprotectedWorkbook, thisNeverGotUnlocked, NewPassword, strDrive, listOfFiles, rehide, outCurrentFile, somethingFound, runLive
' how Many To Loop through
' Change this number to change the amount of things to search through.
' 0 is really 1, 1 is 2, and so on.
'========================================================
Dim rngSearch(0)
dim rngReplace(0)

' Search replacements
rngSearch(0)  = "\\serv1\blah\"
rngReplace(0) = "\\newSever\share\blah\"
'========================================================
' Uncomment or comment to add to the search array.
' rngSearch is what you are searching for.
' rngReplace is what will be replaced based on its cosponsoring search.
'========================================================

' rngSearch(0)  = "\\serv2\blah\
' rngReplace(0) = "\\newSever2\share\blah\"
' rngSearch(1)  = "\\serv3\blah\"
' rngReplace(1) = "\\newSever3\share\blah\"
' rngSearch(1)  = "\\serv4\blah\"
' rngReplace(1) = "\\newSever4\share\blah\"
' rngSearch(2)  = "\\serv5\blah\"
' rngReplace(2) = "\\newSever5\share\blah\"
' rngSearch(3)  = "\\serv6\blah\"
' rngReplace(3) = "\\newSever6\share\blah\"

'========================================================

' Set this to "True" to make the script actually change the things it finds and save.
' This could be in the beginning script to ask if you want to run the script live instead of being hard coded. Maybe later.
runLive = "False"





' Password List
listOfPasses = Split("pass,password1,qwerty,1234,3456,121312,PASSSWORDS",",")
' New Default Password to use per group
changeDefaultPassword = "False"
NewPassword = "D3f@ultP@ssw0rd"
'set the Count of the amount of files to 0 so it can start counting them
countMe = 0
' This is the drive that will be mounted when the script starts
strDrive = "Z:"
' set what objNetwork is for mounting the drive
Set objNetwork = WScript.CreateObject("WScript.Network")
' Set the shell object
Set oWshShell = CreateObject("WScript.Shell")
' Set the  File System object
Set oFSO = CreateObject("Scripting.FileSystemObject")
' Set the excel object
Set objExcel = CreateObject("Excel.Application")
'----------- Variable area - End  ---------------



' Function list = Begin=========================================
' Function  Name: isWorkbookProtected
' Description: This looks at the workbook to see if its protected or not and a True or False
' Input: It needs the object of the workbook that is in question
'isWorkbookProtected Begin ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
Function isWorkbookProtected(WB)
Fx1 = False
If WB.ProtectWindows Then Fx1 = True
If WB.ProtectStructure Then Fx1 = True
If Fx1 = False Then
isWorkbookProtected = Fx1
'MsgBox "The workbook is not protected."
Else
isWorkbookProtected = Fx1
'MsgBox "The workbook is protected."
End If End Function
'isWorkbookProtected End ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~

' Function  Name: isWorksheetProtected
' Description: This looks at the worksheet to see if its protected or not and a True or False
' Input: It needs the object of the worksheet that is in question
'isWorksheetProtected Begin ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
Function isWorksheetProtected(WS)
Fx2 = False
If WS.ProtectContents Then Fx2 = True
If WS.ProtectDrawingObjects Then Fx2 = True
If WS.ProtectScenarios Then Fx2 = True
If Fx1 = False Then
isWorksheetProtected = Fx2
'MsgBox "The worksheet is not protected."
Else
isWorksheetProtected = Fx2
'MsgBox "The worksheet is protected."
End If End Function
'isWorksheetProtected End ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~

' Function  Name: IsWriteAccessible
' Description:  ' Strategy: Attempt to open the specified file in 'append' mode.
' Does not appear to change the 'modified' date on the file.
' Works with binary files as well as text files.
' Only 'ForAppending' is needed here. Define these constants
' outside of this function if you need them elsewhere in your source file.
' Input: It needs the file that is in question
'IsWriteAccessible Begin ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
Function IsWriteAccessible(sFilePath)
Const ForReading = 1, ForWriting = 2, ForAppending = 8
IsWriteAccessible = False
Dim oFso : Set oFso = CreateObject("Scripting.FileSystemObject")
On Error Resume Next
Dim nErr : nErr = 0
Dim sDesc : sDesc = ""
Dim oFile : Set oFile = oFso.OpenTextFile(sFilePath, ForAppending)
If Err.Number = 0 Then
oFile.Close
If Err Then
nErr = Err.Number
sDesc = Err.Description
Else
IsWriteAccessible = True
End if
Else
Select Case Err.Number
Case 70
' Permission denied because:
' - file is open by another process
' - read-only bit is set on file, *or*
' - NTFS Access Control List settings (ACLs) on file
'   prevents access
Case Else
' 52 - Bad file name or number
' 53 - File not found
' 76 - Path not found
nErr = Err.Number
sDesc = Err.Description
End Select
End If

On Error GoTo 0
If nErr Then
Err.Raise nErr, , sDesc
End If
End Function
'IsWriteAccessible End ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ ' Function list = End =========================================




'----------- Create the log file  ---------------
' Set the current Day Time
dt = now
' Create the file system object
Set objFSO=CreateObject("Scripting.FileSystemObject")


'Create the log file name
outLogFile="C:\EXCELFindReplaceVBS\RunLog - "& ((year(dt)*100 + month(dt))*100 + day(dt))*10000 + hour(dt)*100 + minute(dt)& ".txt"
outCurrentFile="C:\EXCELFindReplaceVBS\Currentfile.txt"
' Set the objFileLog to create the log file
Set objFileLog = objFSO.CreateTextFile(outLogFile,True)

' Log entry -------------
objFileLog.Write "Time||TypeOfLog||FileNamePath||SheetInfo||PasswordInfo||Information" & vbCrLf
' Log entry -------------
objFileLog.Write Now & "||ScriptInfo|| || || ||Starting Script " & vbCrLf


if runLive = "True" then
' Log entry -------------
objFileLog.Write now & "||ScriptInfo|| || || ||Script running LIVE changes will be saved."  & vbCrLf
else
' Log entry -------------
objFileLog.Write now & "||ScriptInfo|| || || ||Script running as READ-ONLY, saves will not be saved. "  & vbCrLf
end if



'----------- Setup questions to set the search path  ---------------
' IS this a local drive
isItADrive = MsgBox("Is the drive you want to modify a local drive, like c:\? If its a share, like \\servername\share click no.",3,"Choose options")

 if isItADrive = vbCancel  then
MsgBox("You cancelled the dialogue box, quitting script.")
Wscript.Quit
 end if



if isItADrive = vbYes then
'WScript.Echo "yes its a drive"
strRemoteShare = InputBox("Enter the path of the drive path you want to search, such as . Such as c:\folder\another Folder\","Enter Value", """z:\""")
if strRemoteShare = ""   then
MsgBox("You cancelled the dialogue box, quitting script.")
Wscript.Quit
end if
else
'WScript.Echo "no its not a drive"
' Remove the drive if its mounted...
dim filesys
Set filesys = CreateObject("Scripting.FileSystemObject")
If filesys.DriveExists(strDrive) Then
objNetwork.RemoveNetworkDrive strDrive
End If

' Set what the share path is
strRemoteShare = InputBox("Enter the path of the drive you want to search. Such as \\newSever\share\blah\","Enter Value", """\\newSever\share\blah\""")
if strRemoteShare = ""   then
MsgBox("You cancelled the dialogue box, quitting script.")
Wscript.Quit
end if
'mount the share
objNetwork.MapNetworkDrive strDrive, strRemoteShare, False
end if

' Log entry -------------
objFileLog.Write Now & "||ScriptInfo || || || ||Getting Files List " & vbCrLf  & vbCrLf


'----------- Search the path given for excel files  ---------------
' Run a shell script for a directory search of excel files
sTempFile = oWshShell.ExpandEnvironmentStrings("%Temp%\dir.txt")
oWshShell.Run "cmd.exe /c dir /s /b " + strRemoteShare + "\*.xls* > """ & sTempFile & "", 1, True

' Log entry -------------
objFileLog.Write now & "||ScriptInfo|| || || ||Looping through the files now " & vbCrLf & vbCrLf
' Dump output of the DIR search results to a variable list
Set oList = oFSO.OpenTextFile(sTempFile, 1, False)
aFiles = Split(oList.ReadAll, VbCrLf)
oList.Close
oFSO.DeleteFile sTempFile
' make the alerts from excel not show for smoother scripting and speed
objExcel.DisplayAlerts = False
objExcel.AskToUpdateLinks = False
objExcel.ScreenUpdating = False
objExcel.Visible = True





' Log entry -------------
objFileLog.Write Now & "||ScriptInfo || || || || Found " & Ubound(aFiles) & " files to check." & vbCrLf  & vbCrLf
' Loop through the file names found For Each sName In (aFiles)

' Check to make sure excel is running.. if not restart it.
If Not TypeName(objExcel) = "Object" Then
'strMessage = "Excel Running."
Else
'strMessage = "Excel Not Running."
Set objExcel = CreateObject("Excel.Application")
objFileLog.Write now & "||FileNamePath ||" & sName & " ||NA  ||" & pass & " ||!!!! ERROR !!!! Restarted Excel. "  & vbCrLf
End If


' Testing -  This area for testing only.. can be removed when complete
'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
' Do some counting
countMe = countMe + 1
objFileLog.Write now & "||ScriptInfo ||" & sName & " ||NA  || ||File number: " & countMe & vbCrLf
if countMe = "10000" then
' kill the script after # of excel files...
'WScript.Echo "5000 excels opened and closed"
'WScript.Echo listOfFiles
Exit For
end if
'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
' write name of file to current log
Set objCurrentFile = objFSO.CreateTextFile(outCurrentFile,True)
objCurrentFile.Write sName
objCurrentFile.close


' This is the check if the file is open checker.
if IsWriteAccessible(sName) = "True" Then
if sName = "" or Instr( Ucase(sName), "SYSTEM VOLUME INFORMATION") <> 0 then
' Weed out the blank directory and backups in SYSTEM VOLUME INFORMATION directory from the search
objFileLog.Write now & "||WeedOutDir ||" & sName &" ||NA  ||NA  ||!!!!! Information !!!!! Skipping this directory."  & vbCrLf
else
' make SURE  the alerts from excel not show for smoother scripting and speed resetting them with each excel book
objExcel.DisplayAlerts = False
objExcel.AskToUpdateLinks = False
objExcel.ScreenUpdating = False
objExcel.Visible = True
' Verify that the Excel FILE is not protected. If it is kill it, record it and move on
'-------------------------------------------------------------------------------------
On Error Resume Next
set objWorkbookTestExcelFilePassword =  objExcel.workbooks.open(sName,,,,"xxxx234567890OPIJKHGFHJK90887trfsgdhfjsd89jfosduifjiodsjfo)")
If Err.Number = 1004 Then
'msgbox "This workbook has a password"
' Log entry -------------
objFileLog.Write now & "||ErrorExcelFilePwd ||" & sName &" ||NA  ||NA  ||!!!!! ERROR !!!!! Excel File is protected - Skipping."  & vbCrLf
objWorkbookTestExcelFilePassword.Close False
else
'----------- Start working on the excel file -----------------
' Set what Excel file to open
set objWorkbook = objExcel.Workbooks.Open(sName)
objWorksheetCount = objWorkbook.Worksheets.Count
' Test the workbook for protection
isProtected = isWorkbookProtected(objWorkbook)
somethingFound = "False"
needsToBeReprotectedWorkbook = "False"
' Is the workbook protected?
if isProtected = "True" then
'if not nullWBPass = "True" then
for each pass in listOfPasses
objWorkbook.Unprotect(pass)
Err.Clear
' Now check that if it is unprotected.
isStillProtected = isWorkbookProtected(objWorkbook)
'msgbox "Is it still protected" & isStillProtected
On Error Resume Next
if isStillProtected = "True" then
' try the next one
else
' its unprotected
'Record the protected password.
if changeDefaultPassword = "True" then
correctPassword = NewPassword
else
correctPassword = pass
end if
'tell the script that it needs to be re-protected.
needsToBeReprotectedWorkbook = "True"
' Log entry -------------
objFileLog.Write now & "||ExcelInfoWbUnlock  ||" & sName & " ||NA  ||" & pass & " ||Unlocked The Workbook "  & vbCrLf
' Found the correct password and recorded it.. get out of this loop
end if
next
'END IF if needsToBeReprotectedWorkbook = "False" then
'Since this was locked and it could not be unlocked exit the loop
' Log entry ------------- objFileLog.Write now & "||ExcelErrorUnlock  ||" & sName &" ||" & i & " ||NA || !!!!! ERROR !!!!! Never unlocked Workbook after trying all the passwords. Workbook Status = " & isWorkbookProtected  & vbCrLf
objWorkbook.Close False
'Exit For
end if
else
' Log entry -------------
objFileLog.Write now & "||ExcelInfoWbNotLocked  ||" & sName & " ||NA  || NA ||Workbook is not locked."  & vbCrLf needsToBeReprotectedWorkbook = "False"
end if
'+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
' Connection string area

'Begin - Loop Through the ODBC Connections
For Each ODBCConnection In objWorkbook.Connections

'Begin - Connection String Change '~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
' Reset the connectionStringxRepalced to nothing so that if
' something is found the script can tell the script to change the value.
connectionStringxRepalced = ""
'The counter Loop Variable
countNow = 0
' Set the connectionStringx variable to what the connection is
connectionStringx = ODBCConnection.ODBCConnection.Connection
'Loop Through all possible server name changes
for each x In rngSearch
'Search in the string of connectionStringx using the text from
If Not InStr(1,connectionStringx,rngSearch(countNow), VBTextCompare) = 0 Then
'Create the new String to replace the old one.
connectionStringxRepalced = replace(connectionStringx,rngSearch(countNow),rngReplace(countNow), 1, -1, vbTextCompare)
If NOT connectionStringxRepalced = "" Then
' Log entry -------------
objFileLog.Write now & "||ConnectionStringOld|| " & sName &"|| ||NA ||"  & connectionStringx & vbCrLf
' Log entry -------------
objFileLog.Write now & "||ConnectionStringNew|| " & sName &"|| ||NA ||" & connectionStringxRepalced & vbCrLf somethingFound = "True"
' Log entry -------------
objFileLog.Write now & "||ConnectionString|| " & sName &"|| ||  ||  Replaced the information in the connection string"   & vbCrLf
With objWorkbook.Connections(ODBCConnection.Name).ODBCConnection
.Connection = connectionStringxRepalced
End With
' Found the server in the connection script Exit the FOR loop.
Exit For
End IF
End If
countNow = countNow + 1
Next '~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
'End - Connection String Change
'Begin - Command String Change
'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
' Reset the connectionCommandTextxReplaced to nothing so that if
' something is found the script can tell the script to change the value.
connectionCommandTextxReplaced = ""
'The counter Loop Variable
countNow = 0
' Set the connectionCommandx variable to what the connection is
connectionCommandx = ODBCConnection.ODBCConnection.CommandText
'Loop Through all possible server name changes
for each x In rngSearch
'Search in the string of connectionCommandx using the text from
If Not InStr(1,connectionCommandx,rngSearch(countNow), VBTextCompare) = 0 Then
'Create the new String to replace the old one.
connectionCommandTextxReplaced = replace(connectionCommandx,rngSearch(countNow),rngReplace(countNow), 1, -1, vbTextCompare)
If NOT connectionCommandTextxReplaced = "" Then
' Log entry -------------
objFileLog.Write now & "||ConnectionCommandOld|| " & sName &"|| ||NA ||"  & connectionCommandx & vbCrLf
' Log entry -------------
objFileLog.Write now & "||ConnectionCommandNew|| " & sName &"|| ||NA ||" & connectionCommandTextxReplaced & vbCrLf somethingFound = "True"
' Log entry -------------
objFileLog.Write now & "||ConnectionCommand|| " & sName &"|| ||  ||  Replaced the information in the Command string"   & vbCrLf
With objWorkbook.Connections(ODBCConnection.Name).ODBCConnection
.CommandText = connectionCommandTextxReplaced
End With
' Found the server in the connection script Exit the FOR loop.
Exit For
End IF
End If
countNow = countNow + 1
Next '~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
'End - Command String Change
Next 'End - Loop Through the ODBC Connections

' Clear the array from the last sheet loop
Erase sheetsArray
Erase sheetsArraySheetName
Erase sheetArrayLocked
Erase sheetArrayPassword
Erase sheetArrayRehide
' Set the Array Length ----
' *** NOTE ***********************************************
' This will make the array 1 more than needed.
' The sheet count starts with 1 and arrays start at 0.
' So when the count of the excel workbook sheets is 10
' and is set to the array the array will have 11 spots.
' *********************************************************
ReDim sheetsArray(objWorksheetCount)
ReDim sheetsArraySheetName(objWorksheetCount)
ReDim sheetArrayLocked(objWorksheetCount)
ReDim sheetArrayPassword(objWorksheetCount)
ReDim sheetArrayRehide(objWorksheetCount)

'------------------------------- ' Begin - WorkSheet Loop Section '-------------------------------
' Set this to false if there are no sheets that need to be unprotected it doesn't
' give a false positive.
thisNeverGotUnlocked = "False"
For i = objWorksheetCount To 1 Step -1
' Set the worksheets information for this worksheet
Set objWorksheet = objWorkbook.Worksheets(i)
' Log entry -------------
objFileLog.Write now & "|| ExcelWSOpen|| " & sName &"|| " & i & "||NA ||" & objWorksheet.name & vbCrLf sheetsArraySheetName(i) = objWorksheet.Name
sheetsArray(i) = i
' Check to see if its hidden
If objWorksheet.Visible = False Then
' Log entry -------------
objFileLog.Write now & "||ExcelWSUnhide|| " & sName &"|| " & i & "||NA ||" & objWorksheet.name & vbCrLf 'Its hidden unhide it.
objWorksheet.Visible = True
rehide = "True"
sheetArrayRehide(i) = "True"
sheetsArraySheetName(i) = objWorksheet.Name
else
' Log entry -------------
objFileLog.Write now & "||ExcelWsNotHidden|| " & sName &"|| " & i & "||NA || " & objWorksheet.name & vbCrLf rehide = "False"
sheetArrayRehide(i) = "False"
sheetsArraySheetName(i) = objWorksheet.Name
end if

'does this need to be unlocked?
if isWorksheetProtected(objWorksheet) then
' Log entry -------------
objFileLog.Write now & "||ExcelWsProtected|| " & sName &"|| " & i & "||NA || " & objWorksheet.name & vbCrLf ' Yes
sheetArrayLocked(i) = "True"
sheetsArraySheetName(i) = objWorksheet.Name
'set this to true because if it doesn't get unlocked then it needs to be sent.
' to the if statement below to close the excel file
thisNeverGotUnlocked = "True"
'-----------------------------------------------------------------------------------------------------------------
' Yes it is now let try and unprotected it with a blank password.
On Error Resume next
'objWorksheet.Unprotect
'Err.Clear
' Now check that if it is unprotected.
'-----------------------------------------------------------------------------------------------------------------
for each pass in listOfPasses
'Its going to error if the password is not right so ignore errors.
On Error Resume Next
objWorksheet.Unprotect(pass)
'error clear
Err.Clear
' Now check that if it is unprotected.
isSheetStillProtected = isWorksheetProtected(objWorksheet)
if isSheetStillProtected = "True" then
' try the next one
else
' its unprotected
if changeDefaultPassword = "True" then
' Log entry ------------- objFileLog.Write now & "||ExcelWsWasUnlocked|| " & sName &"|| " & i & "|| " & pass & " ||Worksheet, " & objWorksheet.name & ", unlocked..  pass was: " & pass & " it will be set too " & NewPassword &vbCrLf 'Since the changeDefaultPassword  is true, then set it to default password
correctSheetPassword = NewPassword
sheetArrayPassword(i) = NewPassword
else
' Log entry -------------
objFileLog.Write now & "||ExcelWsWasUnlocked|| " & sName &"|| " & i & "|| " & pass & " ||Worksheet, " & objWorksheet.name & ", unlocked..  pass was: " & pass & vbCrLf 'Record the protected password.
correctSheetPassword = pass
sheetArrayPassword(i) = pass
end if
'tell the script that it needs to be re-protected.
thisNeverGotUnlocked = "False"
isSheetStillProtected = "False"
'Not needed anymore
'needsToBeReprotectedWorksheet = isSheetStillProtected
Exit For
end if
next
' Kill Switch - there was a sheet that was locked but never got unlocked -
' error out this workbook.
' If this did not get set to false in the for loop unlocking the sheet
' it never got unlocked.
If thisNeverGotUnlocked = "True" then
' Log entry -------------
objFileLog.Write now & "||ErrorWsPassword ||" & sName &" ||" & i & " || || " & objWorksheet.name & vbCrLf
objWorkbook.Close False
Exit For
End if
else
'No need to unlock
sheetArrayLocked(i) = "False"
sheetArrayPassword(i) = "NULL"
sheetsArraySheetName(i) = objWorksheet.Name
end if
Next
'-------------------------------
' End - WorkSheet Loop Section
'-------------------------------

'-------------------------------
' Begin - If all the sheets did
' not get unlocked exit the workbook loop
'-------------------------------
if thisNeverGotUnlocked = "True" then
' Log entry -------------
objFileLog.Write now & "||ErrorWsPassword ||" & sName &" ||" & i & " || || !!!! ERROR !!!!  Exiting Workbook - Worksheet could not be unlocked.. Password unknown."  & vbCrLf
objWorkbook.Close False
else
'-------------------------------
' Begin - Do the link change
'-------------------------------
Const xlLinkTypeExcelLinks = 1
Const xlExcelLinks = 1
aLinks = objWorkbook.LinkSources(xlLinkTypeExcelLinks)
If Not IsEmpty(aLinks) Then
For i = 1 To UBound(aLinks)
countNow = 0 for each x In rngSearch
If Not InStr(1,aLinks(i),rngSearch(countNow), VBTextCompare) = 0 Then
somethingFound = "True"
replacedLinktext = replace(aLinks(i),rngSearch(countNow),rngReplace(countNow), 1, -1, vbTextCompare)
' Log entry -------------
objFileLog.Write now & "||ExcelReplaceLink|| " & sName &"|| || || From: " & aLinks(i) & " to: " & replacedLinktext & vbCrLf objWorkbook.ChangeLink aLinks(i), replacedLinktext, xlLinkTypeExcelLinks
Exit For
End If
countNow = countNow + 1
Next next
End If
'-------------------------------
' End - Do the link change
'-------------------------------
'-------------------------------
' Begin - Put Sheets back to the way they were
'-------------------------------
For i = objWorksheetCount To 1 Step -1
Set objWorksheet = objWorkbook.Worksheets(i)
' Relock the worksheet if it was locked if sheetArrayLocked(i) = "True" then objWorksheet.Protect(sheetArrayPassword(i))
' Log entry -------------
objFileLog.Write now & "|| ExcelWsRelocked ||" & sName &" ||" & i & " ||" & correctSheetPassword & " ||Worksheet was re-unlock. "  & vbCrLf
end if
' Rehide the hidden sheet
if sheetArrayRehide(i) = "True" then
objWorksheet.Visible = False
rehide = "False"
' Log entry -------------
objFileLog.Write now & "|| ExcelWsReHidden|| " & sName &"|| " & i & "||NA ||Rehidden Worksheet," & objWorksheet.Name &", Visible = " & objWorksheet.Visible  & vbCrLf
end if
next
'-------------------------------
' End - Put Sheets back to the way they were
'-------------------------------

' Relock the workbook if it was locked if needsToBeReprotectedWorkbook = "True" then objWorkbook.Protect(correctPassword)
' Log entry -------------
objFileLog.Write now & "||ExcelReprotect ||" & sName &" ||   ||" & correctPassword & " ||Workbook," & objWorksheet.Name &", re-unlock."  & vbCrLf
end if
' Set what Excel file to close
If somethingFound = "True" Then
' Check to see if this is going to be saved.
if runLive = "True" Then
objWorkbook.Save
end if
' Log entry -------------
objFileLog.Write now & "||ExcelSaved ||" & sName &" ||    || ||Workbook saved, a change were made."  & vbCrLf
objWorkbook.Close False
else
' Log entry -------------
objFileLog.Write now & "||ExcelNotSaved ||" & sName &" ||    || ||Workbook NOT saved, no change were made."  & vbCrLf
objWorkbook.Close False
end if
' Log entry -------------
objFileLog.Write now & "||ExcelWbClosed ||" & sName &" ||  ||  ||Workbook Closed "  & vbCrLf
End if
end if
'-------------------------------
' End - If all the sheets did not get unlocked exit the workbook loop
'-------------------------------
' End if for password protected file
end if
' Else for if of accessible file
Else
' Log entry -------------
objFileLog.Write now & "||ErrorWbUn-Accessible ||" & sName &" ||NA  ||NA  ||!!!!! ERROR !!!!! Workbook not accessible."  & vbCrLf
objWorkbook.Close False
' End If for if of accessible file
End If

' Log entry - Make a space in between Workbook records. ------------
objFileLog.Write vbCrLf  & vbCrLf  & vbCrLf &vbCrLf
Next

' put excel alerts back on
objExcel.DisplayAlerts = True
objExcel.ScreenUpdating = True
objExcel.AskToUpdateLinks = True
objExcel.Visible = True
' Disconnect the Drive
if isItADrive = vbYes then
else
objNetwork.RemoveNetworkDrive strDrive
end if
msgbox "Processed " & countMe & " Excel Files."
'Close the Log File
objFileLog.Close




No comments:

Post a Comment