Round-trip SolidWorks custom properties through a CSV (no PDM)

Option Explicit

' Two macros, one schema. Export every part's custom properties in a folder
' to CSV, edit in Excel, then write the changes back. Parts only (.SLDPRT) -
' duplicate the loop with swDocASSEMBLY if you also need assemblies.

Const FOLDER As String = "C:\Parts\"                    ' must end with a backslash
Const CSV_PATH As String = "C:\Parts\properties.csv"
Const PROP_NAMES As String = "Description,PartNumber,Material,Revision"  ' edit to your schema

Sub ExportPropertiesToCsv()
    Dim swApp As SldWorks.SldWorks
    Set swApp = Application.SldWorks

    Dim props() As String
    props = Split(PROP_NAMES, ",")

    Dim f As Integer
    f = FreeFile
    Open CSV_PATH For Output As #f
    Print #f, "File," & PROP_NAMES

    Dim fileName As String
    fileName = Dir$(FOLDER & "*.sldprt")
    Dim opened As Long, failed As Long

    Do While fileName <> ""
        Dim errs As Long, warns As Long
        Dim swModel As SldWorks.ModelDoc2
        Set swModel = swApp.OpenDoc6(FOLDER & fileName, swDocPART, _
            swOpenDocOptions_Silent Or swOpenDocOptions_ReadOnly, "", errs, warns)

        If Not swModel Is Nothing Then
            Dim swCustProp As SldWorks.CustomPropertyManager
            Set swCustProp = swModel.Extension.CustomPropertyManager("")

            Dim row As String
            row = fileName
            Dim i As Long
            For i = 0 To UBound(props)
                Dim val As String, resolved As String
                swCustProp.Get4 Trim$(props(i)), False, val, resolved
                row = row & "," & Replace(resolved, ",", ";")  ' a comma here would break the CSV
            Next i
            Print #f, row
            opened = opened + 1
            swApp.CloseDoc swModel.GetTitle
        Else
            failed = failed + 1
            Debug.Print "COULD NOT OPEN: " & fileName
        End If

        fileName = Dir$()
    Loop
    Close #f

    swApp.SendMsgToUser opened & " file(s) exported to:" & vbNewLine & CSV_PATH & _
        vbNewLine & failed & " could not be opened."
End Sub

Sub ImportPropertiesFromCsv()
    Dim swApp As SldWorks.SldWorks
    Set swApp = Application.SldWorks

    Dim props() As String
    props = Split(PROP_NAMES, ",")

    Dim f As Integer
    f = FreeFile
    Open CSV_PATH For Input As #f

    Dim header As String
    Line Input #f, header   ' discard the header row

    Dim updated As Long, failed As Long
    Do While Not EOF(f)
        Dim rowText As String
        Line Input #f, rowText
        Dim cells() As String
        cells = Split(rowText, ",")
        If UBound(cells) < UBound(props) Then GoTo NextRow

        Dim errs As Long, warns As Long
        Dim swModel As SldWorks.ModelDoc2
        Set swModel = swApp.OpenDoc6(FOLDER & cells(0), swDocPART, _
            swOpenDocOptions_Silent, "", errs, warns)

        If Not swModel Is Nothing Then
            Dim swCustProp As SldWorks.CustomPropertyManager
            Set swCustProp = swModel.Extension.CustomPropertyManager("")

            Dim i As Long
            For i = 0 To UBound(props)
                swCustProp.Add3 Trim$(props(i)), swCustomInfoText, cells(i + 1), _
                    swCustomPropertyReplaceValue
            Next i
            swModel.Save3 swSaveAsOptions_Silent, errs, warns
            updated = updated + 1
            swApp.CloseDoc swModel.GetTitle
        Else
            failed = failed + 1
            Debug.Print "COULD NOT OPEN: " & cells(0)
        End If
NextRow:
    Loop
    Close #f

    swApp.SendMsgToUser updated & " file(s) updated, " & failed & " failed." & _
        vbNewLine & "Failures (if any) are in the Immediate window (Ctrl+G)."
End Sub