Revit Import/Export for families- name this the same as the family(with a .txt not rvt extension) for creating an excel based family library manager!

Sub AddReferences()

''---------------------------------------------------------------------------------------------------------------------------------

'' REFERENCES CURRENTLY AVAILABLE:

AddReferenceGUID ("{000204EF-0000-0000-C000-000000000046}") ''VBA                              C:\PROGRA~1\COMMON~1\MICROS~1\VBA\VBA7\VBE7.DLL

AddReferenceGUID ("{00020813-0000-0000-C000-000000000046}") ''Excel                            C:\Program Files\Microsoft Office\Office14\EXCEL.EXE

AddReferenceGUID ("{0D452EE1-E08F-101A-852E-02608C4D0BB4}") ''MSForms                          C:\Windows\system32\FM20.DLL

AddReferenceGUID ("{420B2830-E718-11CF-893D-00A0C9054228}") ''Scripting                        C:\Windows\system32\scrrun.dll

AddReferenceGUID ("{F935DC20-1CF0-11D0-ADB9-00C04FD58A0B}") ''IWshRuntimeLibrary               C:\Windows\system32\wshom.ocx

AddReferenceGUID ("{3F4DACA7-160D-11D2-A8E9-00104B365C9F}") ''VBScript_RegExp_55               C:\Windows\System32\vbscript.dll\3

AddReferenceGUID ("{565783C6-CB41-11D1-8B02-00600806D9B6}") ''WbemScripting                    C:\Windows\system32\wbem\wbemdisp.TLB

AddReferenceGUID ("{2DF8D04C-5BFA-101B-BDE5-00AA0044DE52}") ''Office                           C:\Program Files\Common Files\Microsoft Shared\OFFICE14\MSO.DLL

''---------------------------------------------------------------------------------------------------------------------------------

End Sub

Sub REVIT_SAVE_TO_CSV_TXT_FILE()

'

' SAVE_TO_CSV_TXT_FILE Macro

'

Dim FN As String

Dim FNtxt As String

    FN = ActiveWorkbook.Name

   

    FN = ReturnMatch(FN, "(.*)\.(xl[smx]{1,2}|txt)")   ''regexp to stroup xl?? or txt from filename

   

    FNtxt = ActiveWorkbook.path & "\" & FN & ".TXT"

    FN = ActiveWorkbook.path & "\" & FN & ".XLSm"

   

    Application.DisplayAlerts = False

   

    ActiveWorkbook.SaveAs _

       Filename:=FNtxt, _

       FileFormat:=xlCSV, _

       CreateBackup:=True, _

       ConflictResolution:=xlLocalSessionChanges, _

       AddToMru:=False

   

    ActiveWorkbook.SaveAs _

       Filename:=FN, _

       FileFormat:=xlOpenXMLWorkbookMacroEnabled, _

       CreateBackup:=True, _

       ConflictResolution:=xlLocalSessionChanges, _

       AddToMru:=True

   

    Application.DisplayAlerts = True

End Sub

Sub Revit_Reload_Current()

    Dim FN As String

    Dim I As Integer

    If MsgBox("This will erase everything and relaod the current file- continue?", vbCritical + vbYesNoCancel) <> vbYes Then

        MsgBox "Cancelled."

        Exit Sub

    End If

    ''strip extension

    FN = ThisWorkbook.FullName

    I = Len(FN)

   

    Do While Mid(FN, I, 1) <> "." And I > 0

    I = I - 1

    Loop

   

    I = I - 1

   

    If I = 0 Then

        MsgBox "Error extracting file Name- nothing updated", vbCritical

        Exit Sub

    End If

   

    FN = Left(FN, I) & ".txt"

'

    Range("A1").Select

    With ActiveSheet.QueryTables.add(Connection:= _

        "TEXT;" & FN _

        , Destination:=Range("$A$1"))

        .Name = "acm_LAYOUT"

        .FieldNames = True

        .RowNumbers = False

        .FillAdjacentFormulas = False

        .PreserveFormatting = True

        .RefreshOnFileOpen = False

        .RefreshStyle = xlOverwriteCells

        .SavePassword = False

        .SaveData = True

        .AdjustColumnWidth = True

        .RefreshPeriod = 0

        .TextFilePromptOnRefresh = False

        .TextFilePlatform = 1252

        .TextFileStartRow = 1

        .TextFileParseType = xlDelimited

        .TextFileTextQualifier = xlTextQualifierNone

        .TextFileConsecutiveDelimiter = False

        .TextFileTabDelimiter = True

        .TextFileSemicolonDelimiter = False

        .TextFileCommaDelimiter = True

        .TextFileSpaceDelimiter = False

        .TextFileColumnDataTypes = Array(1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1)

        .TextFileTrailingMinusNumbers = True

        .Refresh BackgroundQuery:=False

    End With

End Sub

Sub REVIT_OPEN_TXT()

Dim strFn As String

strFn = Application.GetOpenFilename _

(Title:="Please choose a file to open", _

FileFilter:="TEXT FILES (*.TXT),")

    If LCase(strFn) = "false" Then

       MsgBox "Nothing selected"

       Exit Sub

    End If

OPEN_TXT strFn

End Sub

Sub OPEN_TXT(strFn As String)

Dim wb As Workbook

    Excel.Workbooks.OpenText Filename:=strFn, _

        Origin:=437, _

        StartRow:=1, DataType:=xlDelimited, TextQualifier:=xlNone, _

        ConsecutiveDelimiter:=False, Tab:=False, Semicolon:=False, Comma:=True _

        , Space:=False, Other:=False, FieldInfo:=Array(Array(1, 1), Array(2, 1), _

        Array(3, 1), Array(4, 1), Array(5, 1), Array(6, 1), Array(7, 1), Array(8, 1), Array(9, 1), _

        Array(10, 1), Array(11, 1), Array(12, 1), Array(13, 1), Array(14, 1), Array(15, 1), Array( _

        16, 1), Array(17, 1), Array(18, 1), Array(19, 1), Array(20, 1), Array(21, 1), Array(22, 1), _

        Array(23, 1), Array(24, 1), Array(25, 1), Array(26, 1), Array(27, 1), Array(28, 1), Array( _

        29, 1), Array(30, 1), Array(31, 1)), TrailingMinusNumbers:=True

   

    wb.Columns("A:BB").EntireColumn.AutoFit

   

    'Do While Len(strFN) > 1 And Right(strFN, 1) <> "\"

    '  strFN = Left(strFN, Len(strFN) - 1)

    'Loop

    'strFN = ActiveWorkbook.Name

strFn = ReturnMatch(strFn, "(.*)\\(.*)\.(xl[smx]{1,2}|txt)", 1)  ''regexp to stroup xl?? or txt from filename

strFn = ActiveWorkbook.path & "\" & strFn & ".XLSX"

ActiveWorkbook.SaveAs Filename:=strFn, FileFormat:=xlCSV, CreateBackup:=True, _

   ConflictResolution:=xlLocalSessionChanges, AddToMru:=False

  

End Sub

Function ReturnMatch(strStr, strMatch, Optional SUBMATCH As Integer)

    ''VBA include Microsoft VBSCript Regular Expressions 5_5

    Dim r 'As New RegExp       ''Regexp engine

    Dim m 'As MatchCollection  ''Return value

    Dim I, X()

    'Dim StrMatch ''as pattern match

    If InStr(1, strMatch, "(") + InStr(1, strMatch, ")") = 0 Then     ''add () for subexpression to return something...

        If Left(strMatch, 1) <> "(" Then strMatch = "(" & strMatch

        If Right(strMatch, 1) <> ")" Then strMatch = strMatch & ")"

    End If

   

    Set r = New regexp

    r.Pattern = strMatch

    r.IgnoreCase = True

   

    Set m = r.Execute(strStr)

   

    ''Regexp os base-o arrays so info rturned starts at (0) not (1)

    On Error Resume Next

    If m.count = 0 Then

        ReturnMatch = ""    ''return null

        Exit Function       ''nomatch

    Else

        ReturnMatch = m(0).SubMatches(SUBMATCH) ''return 1st submatch

    End If

End Function

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

''===REFERENCES TOOLS SECTION=====================================================================================================

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

''RESOLUTION

''For any Automation client to be able to access the VBA object model programmatically, the user running the code must explicitly

''grant access. To turn on access, the user must follow these steps.

''

''Office 2003 and Office XP

''Open the Office 2003 or Office XP application in question. On the Tools menu, click Macro, and

''then click Security to open the Macro Security dialog box.

''

''On the Trusted Sources tab, click to select the Trust access to Visual Basic Project check box to turn on access.

''Click OK to apply the setting. You may need to restart the application for the code to run properly if you automate from a

''Component Object Model (COM) add-in or template.

''

''Office 2007

''Open the 2007 Microsoft Office system application in question. Click the Microsoft Office button, and then click Application Options.

''Click the Trust Center tab, and then click Trust Center Settings.

''Click the Macro Settings tab, click to select the Trust access to the VBA project object model check box, and then click OK.

''Click OK.

''

''---------------------------------------------------------------------------------------------------------------------------------

'' REFERENCES CURRENTLY AVAILABLE:

'' VBA                 {000204EF-0000-0000-C000-000000000046}     C:\PROGRA~1\COMMON~1\MICROS~1\VBA\VBA7\VBE7.DLL

'' Excel               {00020813-0000-0000-C000-000000000046}     C:\Program Files\Microsoft Office\Office14\EXCEL.EXE

'' stdole              {00020430-0000-0000-C000-000000000046}     C:\Windows\system32\stdole2.tlb

'' Office              {2DF8D04C-5BFA-101B-BDE5-00AA0044DE52}     C:\Program Files\Common Files\Microsoft Shared\OFFICE14\MSO.DLL

'' Scripting           {420B2830-E718-11CF-893D-00A0C9054228}     C:\Windows\system32\scrrun.dll

'' IWshRuntimeLibrary  {F935DC20-1CF0-11D0-ADB9-00C04FD58A0B}     C:\Windows\system32\wshom.ocx

''---------------------------------------------------------------------------------------------------------------------------------

Private Sub ListReferencePaths()

    ''http://www.vbaexpress.com/kb/getarticle.php?kb_id=278

     'Macro purpose:  To determine full path and Globally Unique Identifier (GUID)

     'to each referenced library.  Select the reference in the Tools\References

     'window, then run this code to get the information on the reference's library

     'OUTPUT TO DEBUG WINDOW FOR COPY-PASTE ABOVE EACH MODULE

     Dim strFormat

    On Error Resume Next

    Dim I As Long

    'With ThisWorkbook.Sheets(1)

    '    .Cells.Clear

    '    .Range("A1") = "Reference name"

    '    .Range("B1") = "Full path to reference"

    '    .Range("C1") = "Reference GUID"

    'End With

    Debug.Print "''---------------------------------------------------------------------------------------------------------------------------------"

    Debug.Print "'' REFERENCES CURRENTLY AVAILABLE:"

    On Error GoTo ListReferencePathsErr

    For I = 1 To ThisWorkbook.VBProject.References.count

        With ThisWorkbook.VBProject.References(I)

        Debug.Print "AddReferenceGUID(" & VBQT & Trim(Format(.Guid, "!" & String(40, "@"))) & VBQT & ") ''" & Format(.Name, "!" & String(32, "@")) & " " & Format(.FullPath, "!" & String(64, "@"))

            'ThisWorkbook.Sheets(1).Range("A65536").End(xlUp).Offset(1, 0) = .name

            'ThisWorkbook.Sheets(1 ).Range("A65536").End(xlUp).Offset(0, 1) = .FullPath

            'ThisWorkbook.Sheets(1).Range("A65536").End(xlUp).Offset(0, 2) = .GUID

        End With

    Next I

   

    Debug.Print "''---------------------------------------------------------------------------------------------------------------------------------"

On Error GoTo 0

Exit Sub

   

ListReferencePathsErr:

    Debug.Print "''---------------------------------------------------------------------------------------------------------------------------------"

    Debug.Print "''ERROR-- VBA INACCESSIBLE"

    On Error GoTo 0

End Sub

''ThisWorkbook.VBProject.References.AddFromGuid _

''    GUID:="{0002E157-0000-0000-C000-000000000046}", _

''    Major:=5, Minor:=3

Sub AddReference()

    ''http://stackoverflow.com/questions/9879825/how-to-add-a-reference-programmatically

   

    Dim VBAEditor 'As VBIDE.VBE

    Dim VBProj 'As VBIDE.VBProject

    Dim chkRef 'As VBIDE.Reference

    Dim BoolExists As Boolean

    Set VBAEditor = Application.VBE

    Set VBProj = ActiveWorkbook.VBProject

    '~~> Check if "Microsoft VBScript Regular Expressions 5.5" is already added

    For Each chkRef In VBProj.References

        If chkRef.Name = "VBScript_RegExp_55" Then

            BoolExists = True

            GoTo CleanUp

        End If

    Next

    VBProj.References.AddFromFile "C:\WINDOWS\system32\vbscript.dll\3"

CleanUp:

    If BoolExists = True Then

        MsgBox "Reference already exists"

    Else

        MsgBox "Reference Added Successfully"

    End If

    Set VBProj = Nothing

    Set VBAEditor = Nothing

End Sub

''''''------------------------------------------------------------------------------------------------

''http://www.vbaexpress.com/kb/getarticle.php?kb_id=267

Sub AddReferenceGUID(strGUID As String)

     'Macro purpose:  To add a reference to the project using the GUID for the

     'reference library

   

    If strGUID = "" Then Exit Sub

    

    Dim theRef As Variant, I As Long

    

     'Update the GUID you need below.

    ''strGUID = "{00020905-0000-0000-C000-000000000046}"

    

     'Set to continue in case of error

    On Error Resume Next

    

     'Remove any missing references

    For I = ThisWorkbook.VBProject.References.count To 1 Step -1

        Set theRef = ThisWorkbook.VBProject.References.Item(I)

        If theRef.isbroken = True Then

            ThisWorkbook.VBProject.References.Remove theRef

        End If

    Next I

    

     'Clear any errors so that error trapping for GUID additions can be evaluated

    Err.Clear

    

     'Add the reference

    ThisWorkbook.VBProject.References.AddFromGuid _

    Guid:=strGUID, Major:=1, Minor:=0

    

     'If an error was encountered, inform the user

    Select Case Err.Number

    Case Is = 32813

         'Reference already in use.  No action necessary

    Case Is = vbNullString

         'Reference added without issue

    Case Else

         'An unknown error was encountered, so alert the user

        MsgBox "A problem was encountered trying to" & vbNewLine _

        & "add or remove a reference in this file" & vbNewLine & "Please check the " _

        & "references in your VBA project!", vbCritical + vbOKOnly, "Error!"

    End Select

    On Error GoTo 0

End Sub