Cheap hack to find revit file version based on text in file

Attribute VB_Name = "REVIT_CHECK_FILE_VERSION" Option Explicit Const VBQT = """" Private Sub TEST_Revit_File_Version_From_File() ''Function Revit_File_Version_From_File(FN As String) As String Dim oDic As Dictionary ''dictionary of elements Set oDic = CreateObject("Scripting.Dictionary") ''Create the dictionary for scripting Dim Key '2018 works' Set oDic = Revit_File_Version_From_File("C:\_LIB\AUTODESK\REVIT\ootb_I(US)-2019\Annotations\Electrical\Abort Switch Annotation.rfa") '2018 works 'Set oDic = Revit_File_Version_From_File("C:\Users\ron.allen\Documents\REVIT\test-Finish Material.rfa") ''Set oDic = Revit_File_Version_From_File("C:\ProgramData\Autodesk\RVT 2019\Family Templates\English_I\Annotations\Callout Head.rft") For Each Key In oDic.Keys Debug.Print Left(Key & String(80, " "), 80) & oDic.Item(Key) Next Key End Sub Function Revit_File_Version_From_File(FN As String) As Dictionary Dim fso As FileSystemObject ''Access to file and text strem object for reading lines Dim objFile As File ''ObjFile for pulling date time size path owner and othe rinfo from the file Dim fstream As TextStream ''Text stream to read the file Dim strLine As String ''Read one line at a time Dim strcln As String ''to watch original strline and new strclean is cleaned version of string Dim rClean As New regexp ''Regular Expression for cleaning each line to make searching easier - note already native to VBS Dim ref As New regexp ''Regular Expression for searching for items from dictionary - Dim LineCt As Integer ''Line COunter Dim str100 As String ''String for bound lines read in one by one Dim x ''Temporary variable for regex match Dim xx ''Tem variable for regex submatch - th values we are after Dim Key ''variable for looping Keys in dictionary Const vbSpcKey = "{CHR32}" ''end of line ascii characers to temp syb for double spaces Const se = ": {0,}(.*?)[\r\n]" ''value to return from our search Dim oDic As Dictionary ''dictionary of elements Set oDic = CreateObject("Scripting.Dictionary") ''Create the dictionary for scripting Set fso = CreateObject("Scripting.FileSystemObject") ''File System Object- take care FSO is direcly manipulating files Set objFile = fso.GetFile(FN) ''The File name- take care file can direcly manipulate file If objFile Is Nothing Then ''File exist? MsgBox "Cannot file file " & FN End If Set fstream = fso.OpenTextFile(FN, ForReading, False, TristateFalse) ''Text stream to read ''Constant Value Description ''TristateUseDefault -2 Opens the file by using the system default. ''TristateTrue -1 Opens the file as Unicode. ''TristateFalse 0 Opens the file as ASCII. With rClean ''use any .xxx as part of the rclean object .Global = True ''All of it? .IgnoreCase = True ''Uppoer/LowerCase not important? Do While LineCt < 100 And fstream.AtEndOfStream = False ''While under 100 lines and not EOF continue strLine = fstream.ReadLine ''Get a line of text .Pattern = Chr(32) ''Find all double spaces and mark as possible space replacement strcln = rClean.Replace(strLine, vbSpcKey) ''Execute clean ''strcln = Replace(strLine, Chr(32), vbSpcKey, 1, -1, vbBinaryCompare) ''rClean.Replace(strLine, vbSpcKey) ''Sub space key for all double spaces prior to erasing all spaces .Pattern = "[^\!-\~\n\r\R\v\V]" ''Pattern for all chars between "!" and "Tilde" - (removes spaces) strcln = rClean.Replace(strcln, "") ''Execute clean .Pattern = vbSpcKey ''Use special sequence and replace it with a single sapce strcln = rClean.Replace(strcln, " ") ''Sub space key for all double spaces prior to erasing all spaces str100 = str100 & vbCr & strcln ''append carriage return and new clened string to the 100 lines strLine = "": strcln = "" ''Wipe variables just in case LineCt = LineCt + 1 Loop End With ''end with for rclean object fstream.Close ''Close the stream - don't need it anymore. ''''''''''''''''''''''''''''''''''''''''''''''''''''''''' ''start with key - replace value with search using key's current value ''Value on left is lookup key, value on right is firt REGEX match pattern and the swapped for value or N/A if it cannot be found. oDic.add "Username", "Username" & se oDic.add "CentralModel Path", "Central {0,}Model {0,}Path" & se oDic.add "Format", "Format" & se oDic.add "Build", "Build" & se oDic.add "Last Save Path", "Last {0,}Save {0,}Path" & se oDic.add "Open Workset Default", "Open {0,}Workset {0,}Default" & se oDic.add "Project Spark File", "Project {0,}Spark {0,}File\" & se oDic.add "Central Model Identity", "Central {0,}Model {0,}Identity" & se oDic.add "Locale when saved", "Local.?When.*Saved" & se oDic.add "All Local Changes Saved To Central", "All {0,}Local {0,}Changes {0,}Saved {0,}To {0,}Central" & se oDic.add "Central Model's version number corresponding to the last reload latest", "Central {0,}Model.*?version.*?corresponding.*?last {0,}reload {0,}latest" & se oDic.add "Central Model's episode GUID corresponding to the last reload latest", "Central {0,}Model.*?episode.*?GUID.*?last {0,}reload {0,}latest" & se oDic.add "Unique Document GUID", "Unique {0,}Document {0,}GUID" & se oDic.add "Unique Document Increments", "Unique {0,}Document {0,}Increments" & se oDic.add "Model Identity", "Model {0,}Identity" & se oDic.add "IsSingleUserCloudModel", "Is {0,}Single {0,}User {0,}Cloud {0,}Model" & se oDic.add "Author", "Author" & se oDic.add "</A:taxonomy><category><term>", "<entry.*</A:taxonomy><category><term>(.*?)</term>.*</entry>" '''& se oDic.add "<A:family type=", "<entry.*<A:family type=" & VBQT & "(.*?)" & VBQT & ">.*</entry>" oDic.add "<A:variationCount>", "<entry.*<A:variationCount>(.*?)</A:variationCount>.*</entry>" oDic.add "<A:part type=", "<entry.*<A:part type=" & VBQT & "(.*?)" & VBQT & ">.*</entry>" oDic.add "<title>", "<entry.*<title>(.*?)</title>.*</entry>" oDic.add "<Rotate_with_component displayName=", "<entry.*<Rotate_with_component displayName=" & VBQT & "Rotate with component" & VBQT & " type=" & VBQT & "system" & VBQT & " typeOfParameter=" & VBQT & "Yes/No" & VBQT & ">(.*)</Rotate_with_component>.*</entry>" oDic.add "<Keep_text_readable displayName=", "<entry.*<Keep_text_readable displayName=" & VBQT & "Keep text readable" & VBQT & " type=" & VBQT & "system" & VBQT & " typeOfParameter=" & VBQT & "Yes/No" & VBQT & ">(.*)</Keep_text_readable>.*</entry>" oDic.add "<Shared type=", "<entry.*<Shared type=" & VBQT & "system" & VBQT & " typeOfParameter=" & VBQT & "Yes/No" & VBQT & ">(.*)</Shared>.*</entry>" With ref ''Regular expression for reference search .IgnoreCase = True ''Ignore case .Global = True ''Whole thing For Each Key In oDic.Keys ''For each key(from above) .Pattern = oDic.Item(Key) ''Use the pattern If .Test(str100) = True Then ''If test passes on str100 means it found it Set x = .Execute(str100) ''Execute the pattern search to get return values Set x = x.Item(0) ''Set x to return value xx = x.submatches(0) ''Set xx to submatch which is what we are after End If ''End of if .test If xx = "" Then ''If xx is blank oDic.Item(Key) = "N/A" ''return N/A Else ''else or otherwise oDic.Item(Key) = xx ''Return the value End If ''end of structured if then Set x = Nothing: xx = "" ''Just in case clear the variables Next Key ''next key in list End With ''end of with for ref Set Revit_File_Version_From_File = oDic End Function Private Sub char_asc(strStr As String) Dim I For I = 1 To Len(strStr) Debug.Print Asc(Mid(strStr, 2, 1)) & " - " & Mid(strStr, 2, 1) Next I End Sub