Exporting revit family Type Library from imported TXT(CSV/txt) to XLSM to txt file(CSV) using excel (VBA) v23

Attribute VB_Name = "REVIT_EXPORT_Library" ''�2023 Updates to begin including escapint Quotes and commas in fields, and date/Number formats ''�2022 Ron E., Allen - shared under Attribution 4.0 International (CC BY 4.0) ''Attribution 4.0 International (CC BY 4.0) ''You are free to: ''Share � copy and redistribute the material in any medium or format ''Adapt � remix, transform, and build upon the material ''for any purpose, even commercially. ''This license is acceptable for Free Cultural Works. ''The licensor cannot revoke these freedoms as long as you follow the license terms. ''Under the following terms: ''Attribution � You must give appropriate credit, provide a link to the license, and ''indicate if changes were made. You may do so in any reasonable manner, but not in ''any way that suggests the licensor endorses you or your use. '' ''No additional restrictions � You may not apply legal terms or technological ''measures that legally restrict others from doing anything the license permits. ''Notices: ''You do not have to comply with the license for elements of the material in the ''public domain or where your use is permitted by an applicable exception or ''limitation. ''No warranties are given. The license may not give you all of the permissions ''necessary for your intended use. For example, other rights such as publicity, ''privacy, or moral rights may limit how you use the material. Option Explicit Const VBQT = """" Function CheckFilepath(ByRef filepath) ''subs out sharepoint filepath for 'local' If LCase(filepath) Like "http*sharepoint*" Then ''Sharepoint hack to try to rewrite to local drive path... If filepath Like "http*/Documents/*" Then ''we can take a guess to the local locaiton filepath = Environ$("USERPROFILE") & "\OneDrive - Ware Malcomb\Documents" & Right(filepath, Len(filepath) - 18 - InStr(1, filepath, "documents/", vbTextCompare)) filepath = Replace(filepath, "/", "\", 1, -1, vbTextCompare) Else MsgBox "Cannot save to OneDrive, malformed path. OK to cancel", vbCritical + vbOKOnly, "Malformed path - Onedrive" End If ''Stop ''redirect to local ... End If End Function '======================================================================== 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 ncol As Integer Dim RowMax As Integer Dim ColMax As Integer Dim strCell As String ''For escaping special characters likr "," and "" Dim strLine As String ''Writeline Dim strFmt As String Dim DateOld As Date ''olf created time stamp Dim DateNew As Date ''new date Dim ofile As File ''access FSO file '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(1) ' 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) & ".txt" ''CSV with TXT extension CheckFilepath filepath ''For onedrive/sharepoint filepath - need to bring back to C: or error out If FSO.FileExists(filepath) Then ''compare date and delete old file. DateOld = FSO.GetFile(filepath).DateCreated ''get date created save in old FSO.DeleteFile filepath, True ''delete filepath+FN End If ''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).NumberFormatLocal If strFmt Like "General" Then strFmt = "" strCell = "" ''clear cell strCell = Format(ws.Cells(nRow, ncol).Value, strFmt) ''Format text ''Escape quotes in cell If InStr(1, strCell, Chr(34)) Then ''need to escape " with "" in write strCell = Replace(strCell, Chr(34), Chr(34) & Chr(34), 1) ''replace " with "" End If ''escape entire string if comma in string If InStr(1, strCell, ",") Then ''Add quotes to excape comma in line text strCell = Chr(34) & strCell & Chr(34) ''Add " around write to escape commas End If strLine = strLine & strCell & "," End If Next ncol strLine = Left(strLine, Len(strLine) - 1) '''Print #objTxtFile, strLine & vbCrLf objTxtFile.Write (strLine & vbLf) Next nRow ''Close objTxtFile objTxtFile.Close If FSO.FileExists(filepath) Then DateNew = FSO.GetFile(filepath).DateCreated If DateNew > DateOld Then MsgBox "Updated: " & vbCr & filepath & vbCr & "AT:" & vbCr & Format(DateNew, "YYYY-MM-DD t HH:MM:SSa/p"), vbOKOnly + vbInformation, "Success writing new file" Else MsgBox "Error- date/time stamp not updated. Please check file updated properly.", vbOKOnly + vbCritical, "ERROR- Write may have failed" End If VBA.Shell "C:\windows\explorer.exe /select, " & "" & filepath & "", vbNormalFocus Else MsgBox "File missing. Check if you have write permissions in this location.", vbCritical + vbOKCancel, "Error- Missing file" End If Set FSO = Nothing ''Clear objects End Sub