Bluebeam User name swap script and backup user prefs

Option Explicit ''2020-06-25 RON.ALLEN@KTGY.COM Const ForReading = 1 ''TEXT FILE CONSTANTS Const ForWriting = 2 Const ForAppending = 8 Const TristateUseDefault = -2 ''TEXT FILE WRITE CONSTANTS Const TristateTrue = -1 ''unicode Const TristateFalse = 0 ''ascii ''regex'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' Const strBBrepl = "([\s\S]{1,}<General>)([\s\S]{1,}<UserName>)(.+)(<\/UserName>)([\s\S]{1,})" ''REGEX OVERVIEW:''$1'''''''''''''''''''$2''''''''''''''''''''$3''$4''''''''''''$5 ''''''''''''Replacement="$1$2" & UserName & "$4$5" '''''''''''''''''''''''''''''Any Char''<General>'Any Char'''<USER>'*ID*''</USER>off+(Rest of file) ''REgex [\s\S]{1,} = one or more of *any+every* character including newline/beak ''Keys in to find closest match of <GENERAL> XML START WITH <USER> INSIDE IT, extracts the user ID and all fields are replaced. ''vba ref active ds library MAIN Sub MAIN() ''NOTE - This is a blunt 'hack and swap' using REGEX. - Ron.Allen Dim WS 'AS New WshShell ''WSH Windows scripting host Dim fpBB 'AS String ''file path bluebeam for each version - will iterate versions Dim fn 'AS String ''File name Dim objFold 'AS Folder '' BB folder Dim objSf 'AS Folder ''Subfolder iterate Dim objTXTfile 'AS TextStream ''r/w text file Dim strTXT 'AS String ''String to hold XML file (Watch for unicode issues?) Dim strUsername 'AS String ''user Name String to replace Dim Pass 'AS Boolean ''pass fail on find Dim strMsg 'AS String ''String message builder Dim FSO 'As New FileSystemObject ''Direct access to files (Be careful!) Set FSO = CreateObject("Scripting.FileSystemObject") ''Create FSO object ''''''''GET USER FIRST AND LAST NAME FROM LDAP'''''''''''''''''''''''''' ''Pull from full name and title - outlook? AD? **LDAP**: Dim objSysInfo Dim objcurrentuser Set objSysInfo = CreateObject("ADSystemInfo") Set objcurrentuser = GetObject("LDAP://" & objSysInfo.UserName) strUsername = objcurrentuser.givenName & " " & objcurrentuser.LastName Set objcurrentuser = Nothing Set objSysInfo = Nothing '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' ''User Path E.G. ''C:\Users\ron.allen\AppData\Roaming\Bluebeam Software\Revu\19\UserPreferences.xml Set WS = CreateObject("WScript.Shell") fpBB = WS.ExpandEnvironmentStrings("%APPDATA%") & "\Bluebeam Software\Revu\" ''Revu path

Set objFold = FSO.GetFolder(fpBB) ''Set working folder Dim i For Each objSf In objFold.SubFolders ''Run thorugh subfolders for version match ''18,19,20 uses userpref xml file <<<<EDIT FOR ADDING NEW VERSIONS! If (objSf.Name = "18" Or objSf.Name = "19" Or objSf.Name = "20") _ And _ FSO.FileExists(objSf.Path & "\UserPreferences.xml") _ Then strMsg = strMsg & "REVU " & objSf.Name & ":" & vbCr ''inform REVU verison modified '''WScript.Echo objSf.Path & "\UserPreferences.xml" <<<debug ''Get text file (each 2019, 2019, 2020 folder) Set objTXTfile = _ FSO.OpenTextFile( _ objSf.Path & "\UserPreferences.xml", _ ForReading, _ False, _ TristateFalse) strTXT = objTXTfile.ReadAll ''Read the TXT file into a string objTXTfile.Close ''Close it Pass = False ''Set pass to false - if true it will continue with the file Pass = regex_REPL(strTXT, strBBrepl, "$1$2" & strUsername & "$4$5") ''Test the REGulaeEXpressions replace see regex101.com for REGEX~! If Not Pass Then ''If failed and didn't find it - add to message strMsg = strMsg & "FAIL! Username change: " & vbCr & _ objSf.Path & "\UserPreferences.xml" ''Add to message Else ''Else it passed strMsg = strMsg & "PASS! usernmae change: " & vbCr & _ objSf.Path & "\UserPreferences.xml" ''Add to message ''add backup original here strMsg = strMsg & vbCr & BackupSingleFile(objSf.Path & "\UserPreferences.xml", False, False) Set objTXTfile = _ FSO.CreateTextFile(objSf.Path & _ "\UserPreferences.xml", _ True, _ False) objTXTfile.Write (strTXT) objTXTfile.Close End If Else strMsg = strMsg & vbCr & "FOLDER SKIP: " & vbCr & _ objSf.Path & "\UserPreferences.xml" End If strMsg = strMsg & vbCr i = i + 1: If i > 4 Then Stop Next ''objSf MsgBox strMsg, vbOKOnly End Sub ''backup single file to redord_FN folder file and return string message 'Private Function BackupSingleFile(StrFP As String, _ ' Optional BackupFolderAppendFN As Boolean = False, _ ' Optional CleanBackupFolderName As Boolean = True) As String Private Function BackupSingleFile(StrFP, _ BackupFolderAppendFN, _ CleanBackupFolderName) ''takes Filename and optional clean up folder name and makes a copy of the file to a folder of the same name ''optional clean removes any funky characters and replaces with a "-" and removes duplicte "-" Dim ObjFile ''As File ''file object Dim FSO ''As FileSystemObject Set FSO = CreateObject("Scripting.FileSystemObject") ''Create FSO object Dim objFolder ''As Folder ''Current folder Dim strRecordFolderName ''As String ''record folder name "RECORD-" + base Filename Dim strFN ''As String ''str base file nmae no extension Dim strExt ''As String ''filename extension Dim dateMod ''As Date ''DATE for date mosified dim WshShell 'AS WshShell ''For opening file folder to check if there are a ton of backups in there If Not FSO.FileExists(StrFP) Then ''If file does NOT exist- warn BackupSingleFile = BackupSingleFile & "NOT FOUND: " & StrFP ''mesage returned Exit Function End If ''else continue... Set ObjFile = FSO.GetFile(StrFP) strFN = FSO.GetBaseName(StrFP) ''base file name w/o extension strExt = FSO.GetExtensionName(StrFP) ''extension for file - i.e. .xml dateMod = ObjFile.DateLastModified ''date last modified for timestamp ''condition for typical RECORD folder name ''or RECORD-[File Name Append] for cleaner tracking of backed up individual files If Not BackupFolderAppendFN Then ''Just use RECORD for backup folder strRecordFolderName = "RECORD" Else ''If append FN, then append the filename strRecordFolderName = "RECORD-" & UCase(strFN) If CleanBackupFolderName Then ''If cleanup FN apply to appended FN on record folde rname ''RECORD folder name - stick to base characters - replaec others with "-" regex_REPL strRecordFolderName, "[^A-Za-z0-9\.\,\(\)\+\=]{1,}", "-" ''RECORD folder name - remove trailing "-" regex_REPL strRecordFolderName, "\-{1,}$", "" End If End If ''parent folder for RECORD folder creation Set objFolder = ObjFile.ParentFolder ''Current folder If FSO.FolderExists(objFolder.Path & "\" & strRecordFolderName) Then 'see if user prefs backup folder exists Set objFolder = FSO.GetFolder(objFolder.Path & "\" & strRecordFolderName) ''it does, use it Else Set objFolder = FSO.CreateFolder(objFolder.Path & "\" & strRecordFolderName) ''it didn't create and use that End If ''format the NEW filename for the copied file... strFN = objFolder.Path & "\" & strFN & "-" _ & Year(dateMod) & "-" _ & Right("00" & Month(dateMod), 2) & "-" _ & Right("00" & Day(dateMod), 2) & "-" _ & Right("00" & Month(dateMod), 2) & "t" _ & Right("00" & Hour(dateMod), 2) _ & Right("00" & Minute(dateMod), 2) If Hour(dateMod) < 12 Then ''add redundant a/p to help id as time format strFN = strFN & "a" Else strFN = strFN & "p" End If strFN = strFN & "." & strExt ''Filename + Datemod in YYYY-MM-DDtHHnna/p ''copy file to backp user prefs folder and append with date time - if exists, overwrite as necessary ObjFile.Copy strFN, True ''verify in messages if fail pass: If FSO.FileExists(strFN) Then BackupSingleFile = BackupSingleFile & vbCr & "BACKUP EXISTS: " & strFN Set WshShell = WScript.CreateObject("WScript.Shell") ''open RECORD locaiton WshShell.Run "Explorer /e, " & objFolder.Path set WshShell = nothing Else BackupSingleFile = BackupSingleFile & vbCr & "BACKUP FAIL: " & strFN End If End Function Private Sub testre() Debug.Print regex_REPL("123<General>456<Username>ron.allen</Username>789", _ strBBrepl, "$1$2" & "New.User.ID.SOMCREDENTIAL" & "$4$5") End Sub ''regex_REPL ''strSource (called BYREF= "by reference = whatever I do to it here changes the variable from the call! ''strPattern= for the pattern to search ''strRepl = character to replace string, see regex101.com for REGEX~! find/match.replace! Public Function regex_REPL(ByRef strSource, strPattern, strRepl) 'AS Boolean Dim objRegEx 'AS New REGEXP ''VBS Regex declare Dim Found 'AS Boolean ''Found check Set objRegEx = CreateObject("vbscript.regexp") ''VBS Regex objRegEx.Pattern = strPattern ''Pattern to match objRegEx.Global = True ''Thorugh entire string global = true objRegEx.IgnoreCase = True ''Ignore CaSe of letters Found = objRegEx.Test(strSource) ''Test if matches string regex_REPL = Found ''set function success/fail If Not Found Then ''If test failed - no need to execute- not found Exit Function ''exit function End If strSource = objRegEx.Replace(strSource, strRepl) ''Byref replaces strsource with replaced values End Function