Revit CSV file manager for families and re-exporting to a CSV file

Process:

• Export a Revit library file - maintains the same name as the family (This is critical)
• Create an EXCEL file same-name XLSM macro enabled
• Create a Worksheet "EXPORT"
• Create other tabs to build data sheets
• Create a sheet and use DATA LINK to bring in the exported library
• Copy the important 1st row IDs for the Variable names and types over.
• All of them are not necessary - only the ones with data
• Library export ONLY exports parameters that have data in them somewhere
• Order doesn't matter.
• Paste the code below into a module
• Run it to export the "EXPORT" tab
• Excel saves-as the [excel filename.TXT]
• Excel saves as the [excel filename.XMSM]
• Refresh the data source for updates
• SAVE OFTEN!

Version 2.0- The Textfile in VBA has issues - keeps trying to write in Unicode and Kanji instead of basic ASCII.

Also Revit format for families is noting in cell 1,1 and all Line Feeds (Not CRLFS or CRs ) at the end of lines.

Attribute VB_Name = "REVIT_EXPORT_Library" Option Explicit Const VBQT = """" Sub REVIT_EXPORT_CATALOG_1st_row_params() Dim ws As Worksheet Dim objTxtFile As TextStream ''As Integer Dim FilePath As String Dim strN As String Dim nRow As Integer Dim ncol As Integer Dim RowMax As Integer Dim ColMax As Integer Dim strLine As String Dim strFmt As String If MsgBox("This exports the entire catalog from the 'EXPORT' tab using the first row as parameters. Continue?", vbInformation + vbYesNo) <> vbYes Then MsgBox "Exititng", vbExclamation Exit Sub End If Dim FSO As FileSystemObject Set FSO = CreateObject("Scripting.FileSystemObject") Set ws = ActiveWorkbook.Worksheets("EXPORT") ' RowMax = Cells.Find("*", [a1], xlFormulas, , xlByRows, xlPrevious).row ColMax = Cells.Find("*", [a1], xlFormulas, , xlByColumns, xlPrevious).Column strN = ThisWorkbook.Name strN = Left(strN, InStr(Len(strN) - 5, strN, ".", vbTextCompare) - 1) ws.Activate Application.DisplayAlerts = False FilePath = UCase(ws.Parent.Path & "\" & strN) & ".csv" If VBA.Dir(ws.Parent.Path & "\" & strN & ".csv") <> "" Then FSO.DeleteFile (ws.Parent.Path & "\" & strN & ".csv") ''fso text file- the textwrite has issues with uinicode and Kanji characters showing upp in lieu of ASCII '''https://docs.microsoft.com/en-us/office/vba/language/reference/user-interface-help/openobjTxtFile-method Set objTxtFile = FSO.CreateTextFile(FilePath, True, False) RowMax = ws.Cells(Rows.Count, 1).End(xlUp).row ColMax = ws.Cells(1, Columns.Count).End(xlToLeft).Column For nRow = 1 To RowMax strLine = "" For ncol = 1 To ColMax If nRow = 1 And ncol = 1 Then ''null for upper left cell always! strLine = strLine & "," Else strFmt = ws.Cells(nRow, ncol).NumberFormat If strFmt Like "General" Then strFmt = "" strLine = strLine & Format(ws.Cells(nRow, ncol).Value, strFmt) & "," End If Next ncol strLine = Left(strLine, Len(strLine) - 1) '''Print #objTxtFile, strLine & vbCrLf objTxtFile.Write (strLine & vbLf) Next nRow ''Close objTxtFile objTxtFile.Close Set FSO = Nothing If VBA.Dir(ws.Parent.Path & "\" & strN & ".csv") <> "" Then MsgBox ":File Exists- Please verify Success writing: " & vbCr & vbCr & FilePath, vbInformation VBA.Shell "C:\WINDOWS\explorer.exe """ & ws.Parent.Path & "", vbNormalFocus Else MsgBox "Error writing", vbCritical End If End Sub Sub REVIT_EXPORT_CATALOG_1strow_mapped_params() Dim ws As Worksheet Dim objTxtFile As TextStream ''As Integer Dim FilePath As String Dim strN As String Dim nRow As Integer Dim ncol As Integer Dim RowMax As Integer Dim ColMax As Integer Dim strLine As String Dim strFmt As String Dim cols As New Collection Dim obj Dim FSO As FileSystemObject If MsgBox("This exports catalogs using the first row of the 'EXPORT' tab." & vbCr & vbCr & _ "Parameters will skip the second row and use the corresponding values from column1 (family name) & marked columns." & vbCr & vbCr & _ "Continue?", vbInformation + vbYesNo) <> vbYes Then MsgBox "Exititng", vbExclamation Exit Sub End If Set FSO = CreateObject("Scripting.FileSystemObject") On Error Resume Next Set ws = ActiveWorkbook.Worksheets("EXPORT") If ws Is Nothing Then MsgBox "Error opening " & VBQT & "EXPORT" & VBQT & " worksheet." & vbCr & "Exiting.", vbCritical Exit Sub End If RowMax = Cells.Find("*", [a1], xlFormulas, , xlByRows, xlPrevious).row ColMax = Cells.Find("*", [a1], xlFormulas, , xlByColumns, xlPrevious).Column strN = Application.ActiveWorkbook.Name strN = Left(strN, InStr(Len(strN) - 5, strN, ".", vbTextCompare) - 1) ws.Activate Application.DisplayAlerts = False FilePath = UCase(ws.Parent.Path & "\" & strN) & ".csv" FSO.DeleteFile (FilePath) If FSO.FileExists(FilePath) Then MsgBox "ERROR: File cannot be deleted." & vbCr & vbCr & "Check if it is read only, " & vbCr & vbCr & "-THEN-" & vbCr & vbCr & "Try closing revit and waiting for file to become available to read/write.", vbCritical Exit Sub End If On Error GoTo 0 ''fso text file- the textwrite has issues with uinicode and Kanji characters showing upp in lieu of ASCII '''https://docs.microsoft.com/en-us/office/vba/language/reference/user-interface-help/openobjTxtFile-method Set objTxtFile = FSO.CreateTextFile(FilePath, True, False) RowMax = ws.Cells(Rows.Count, 1).End(xlUp).row ColMax = ws.Cells(1, Columns.Count).End(xlToLeft).Column ''Stop ''Look at first row for non-blank parameters For ncol = 1 To ColMax If ws.Cells(1, ncol).Value > "" Or ncol = 1 Then cols.Add (ncol) ''add first column-assuming family name and any column with data in 1st row Next ncol For nRow = 1 To RowMax If nRow = 2 Then nRow = 3 ''skip row 2 strLine = "" ''For each of the used columns repeat the export For Each obj In cols ncol = obj If nRow = 1 And ncol = 1 Then ''null for upper left cell always! strLine = strLine & "," Else strFmt = ws.Cells(nRow, ncol).NumberFormat If strFmt Like "General" Then strFmt = "" strLine = strLine & Format(ws.Cells(nRow, ncol).Value, strFmt) & "," End If Next obj strLine = Left(strLine, Len(strLine) - 1) '''Print #objTxtFile, strLine & vbCrLf objTxtFile.Write (strLine & vbLf) Next nRow ''Close objTxtFile objTxtFile.Close Set FSO = Nothing If VBA.Dir(ws.Parent.Path & "\" & strN & ".csv") <> "" Then MsgBox ":File Exists- Please verify Success writing: " & vbCr & vbCr & FilePath, vbInformation VBA.Shell "C:\WINDOWS\explorer.exe """ & ws.Parent.Path & "", vbNormalFocus Else MsgBox "Error writing", vbCritical End If End Sub