Edit properties from Excel for Solidworks with the Document manager API

Hello;
I would like to modify the properties of my Solidworks projects with Excel, for this I thought of using the Solidworks " Document manager " API.
So I adapted an existing code in order to be able to use it but unfortunately, I have an error on a function of the " SolidWorks document manager " library for which I can't find a solution.

" An ActiveX component cannot create an object "

The position in question:

Set swDmDoc = swDmApp.GetDocument(path, docType, readOnly, openDocErr)

With SwDmDoc = Nothing

here is the code (PS: the code needs a personal license key that I can't show you)

Const SW_DM_KEY As String = "Clé perso"

Sub main()
End Sub

Function ConnectToDm() As SwDocumentMgr.SwDMApplication

    Dim swDmClassFactory As SwDocumentMgr.swDmClassFactory
    Dim swDmApp As SwDocumentMgr.SwDMApplication
    
    Set swDmClassFactory = CreateObject("SwDocumentMgr.SwDMClassFactory")
        
    If Not swDmClassFactory Is Nothing Then
        Set swDmApp = swDmClassFactory.GetApplication(SW_DM_KEY)
        Set ConnectToDm = swDmApp
    Else
        Err.Raise vbError, "", "Document Manager SDK is not installed"
    End If
    
End Function

Function OpenDocument(swDmApp As SwDocumentMgr.SwDMApplication, path As String, readOnly As Boolean) As SwDocumentMgr.SwDMDocument10
    
    Dim ext As String
    ext = LCase(Right(path, Len(path) - InStrRev(path, ".")))
    
    Dim docType As SwDmDocumentType
    
    Select Case ext
        Case "sldlfp"
            docType = swDmDocumentPart
        Case "sldprt"
            docType = swDmDocumentPart
        Case "sldasm"
            docType = swDmDocumentAssembly
        Case "slddrw"
            docType = swDmDocumentDrawing
        Case Else
            Err.Raise vbError, "", "Unsupported file type: " & ext
    End Select
    
    Dim swDmDoc As SwDocumentMgr.SwDMDocument10
    Dim openDocErr As SwDmDocumentOpenError
    Set swDmDoc = swDmApp.GetDocument(path, docType, readOnly, openDocErr)
    
    If swDmDoc Is Nothing Then
        Err.Raise vbError, "", "Failed to open document: '" & path & "'. Error Code: " & openDocErr
    End If
    
    Set OpenDocument = swDmDoc
    
End Function

Public Function GETSWPRP(fileName As String, prpNames As Variant, Optional confName As String = "") As Variant
    
    Dim swDmApp As SwDocumentMgr.SwDMApplication
    Dim swDmDoc As SwDocumentMgr.SwDMDocument10
    
try_:
    On Error GoTo catch_
    
    Dim vNames As Variant
            
    If TypeName(prpNames) = "Range" Then
        vNames = RangeToArray(prpNames)
    Else
        vNames = Array(CStr(prpNames))
    End If
    
    Set swDmApp = ConnectToDm()
    Set swDmDoc = OpenDocument(swDmApp, fileName, True)
    
    Dim res() As String
    Dim i As Integer
    ReDim res(UBound(vNames))
    
    Dim prpType As SwDmCustomInfoType
    
    If confName = "" Then
        For i = 0 To UBound(vNames)
            res(i) = swDmDoc.GetCustomProperty(CStr(vNames(i)), prpType)
        Next
    Else
        Dim swDmConf As SwDocumentMgr.SwDMConfiguration10
        Set swDmConf = swDmDoc.ConfigurationManager.GetConfigurationByName(confName)
        If Not swDmConf Is Nothing Then
            For i = 0 To UBound(vNames)
                res(i) = swDmConf.GetCustomProperty(CStr(vNames(i)), prpType)
            Next
        Else
            Err.Raise vbError, "", "Failed to get configuration '" & confName & "' from '" & fileName & "'"
        End If
    End If
    
    GETSWPRP = res
    
    GoTo finally_
    
catch_:
    Debug.Print Err.Description
    Err.Raise Err.Number, Err.Source, Err.Description
finally_:
    If Not swDmDoc Is Nothing Then
        swDmDoc.CloseDoc
    End If

End Function

Public Function SETSWPRP(fileName As String, prpNames As Variant, prpVals As Variant, Optional confName As String = "")
    
    Dim swDmApp As SwDocumentMgr.SwDMApplication
    Dim swDmDoc As SwDocumentMgr.SwDMDocument10
    
try_:
    On Error GoTo catch_
    
    If TypeName(prpNames) <> TypeName(prpVals) Then
        Err.Raise vbError, "", "Property name and value must be of the same type, e.g. either range or cell"
    End If
    
    Dim vNames As Variant
    Dim vVals As Variant
        
    If TypeName(prpNames) = "Range" Then
        
        vNames = RangeToArray(prpNames)
        
        vVals = RangeToArray(prpVals)
        
        If UBound(vNames) <> UBound(vVals) Then
            Err.Raise vbError, "", "Number of cells in the name and value are not equal"
        End If
    Else
        vNames = Array(CStr(prpNames))
        vVals = Array(CStr(prpVals))
    End If
    
    Set swDmApp = ConnectToDm()
    Set swDmDoc = OpenDocument(swDmApp, fileName, False)
    
    Dim i As Integer
    
    If confName = "" Then
        For i = 0 To UBound(vNames)
            swDmDoc.AddCustomProperty CStr(vNames(i)), swDmCustomInfoText, CStr(vVals(i))
            swDmDoc.SetCustomProperty CStr(vNames(i)), CStr(vVals(i))
        Next
    Else
        Dim swDmConf As SwDocumentMgr.SwDMConfiguration10
        Set swDmConf = swDmDoc.ConfigurationManager.GetConfigurationByName(confName)
        
        If Not swDmConf Is Nothing Then
            For i = 0 To UBound(vNames)
                swDmConf.AddCustomProperty CStr(vNames(i)), swDmCustomInfoText, CStr(vVals(i))
                swDmConf.SetCustomProperty CStr(vNames(i)), CStr(vVals(i))
            Next
        Else
            Err.Raise vbError, "", "Failed to get configuration '" & confName & "' from '" & fileName & "'"
        End If
    End If
    
    swDmDoc.Save
    
    SETSWPRP = "OK"
    
    GoTo finally_
    
catch_:
    Debug.Print Err.Description
    Err.Raise Err.Number, Err.Source, Err.Description
finally_:
    If Not swDmDoc Is Nothing Then
        swDmDoc.CloseDoc
    End If
    
End Function

Private Function RangeToArray(vRange As Variant) As Variant
    
    If TypeName(vRange) = "Range" Then
        Dim excelRange As Range
        Set excelRange = vRange
        
        Dim i As Integer
        
        Dim valsArr() As String
        ReDim valsArr(excelRange.Cells.Count - 1)
        
        i = 0
        
        For Each cell In excelRange.Cells
            valsArr(i) = cell.Value
            i = i + 1
        Next
        
        RangeToArray = valsArr
        
    Else
        Err.Raise vbError, "", "Value is not a Range"
    End If
    
End Function

Base Code:

Thank you in advance

Hello
Since they are functions, you have to call them in the Main procedure otherwise you can only have an empty value for the SwDmDoc variable. Otherwise, you also have to manage the ReadOnly status, otherwise you won't be able to change the properties.

Hello;
I agree with @Cyril.f and I will also add to check that you load the reference:
SwDocumentMgr 2022Type Library
(2022 = current Solidworks release)

Kind regards.

2 Likes

Hello Cyril.f and Maclane,

Thank you for your feedback, I have a hard time understanding what you mean by " call them in the main procedure".
I tried to call them by doing: Call + name of my function or just by putting the name of my function (Example: OpenDocument) and it gives me an error:

Can you give me an example of your explanation.

Thanks in advance

Hello
You have to call the opendocument function with the expected arguments, either if I don't make a mistake, a line of this type:

OpenDocument(connecttodm(),FilePath,true)

You need to connect to the license to use the API, the path to the targeted file and set true or false to have the file read-only or not.

Thank you for your help but it still doesn't work, my " OpenDocument " function is already called in my GETSWPRP function and if I call it in the hand it doesn't change anything.

The path, docty, readonly as well as the oppenDocErr are well informed, but I still get the error " An ActiveX component cannot create an object "

I saw that it could come from the compatibility between my Excel and Solidworks (32 bits and 64 bits).
Do you think that I can continue this VBA project or it doesn't depend on me but on the system

Kind regards

Can you put your complete code that I can test? (without the key of course)

A screenshot of your loaded libraries would also be appreciated;
I suspect a lack of:
Microsoft ActiveX data objects ... Library
and
Microsoft ActiveX data objects recordset ... Library

It is possible that this is also due to an error copying your Document Manager key.
VB does not accept more than 1023 characters on a line.
(the division must be in the form of "text then space then underscore then line breaks then the rest of the text...).

Kind regards.

3 Likes

Hello @Cyril.f and @Maclane,
Thank you for your answer
My code:

Const SW_DM_KEY As String = "<>"


Sub main()
'Call OpenDocument(ConnectToDm(), fileName, True)

End Sub

Function ConnectToDm() As SwDocumentMgr.SwDMApplication

    Dim swDmClassFactory As SwDocumentMgr.swDmClassFactory
    Dim swDmApp As SwDocumentMgr.SwDMApplication
    
    Set swDmClassFactory = CreateObject("SwDocumentMgr.SwDMClassFactory")
        
    If Not swDmClassFactory Is Nothing Then
        Set swDmApp = swDmClassFactory.GetApplication(SW_DM_KEY)
        Set ConnectToDm = swDmApp
    Else
        Err.Raise vbError, "", "Document Manager SDK is not installed"
    End If
    
End Function

Function OpenDocument(swDmApp As SwDocumentMgr.SwDMApplication, path As String, readOnly As Boolean) As SwDocumentMgr.SwDMDocument10
    
    Dim ext As String
    ext = LCase(Right(path, Len(path) - InStrRev(path, ".")))
    
    Dim docType As SwDmDocumentType
    
    Select Case ext
        Case "sldlfp"
            docType = swDmDocumentPart
        Case "sldprt"
            docType = swDmDocumentPart
        Case "sldasm"
            docType = swDmDocumentAssembly
        Case "slddrw"
            docType = swDmDocumentDrawing
        Case Else
            Err.Raise vbError, "", "Unsupported file type: " & ext
    End Select
    
    Dim swDmDoc As SwDocumentMgr.SwDMDocument10
    Dim openDocErr As SwDmDocumentOpenError
    Set swDmDoc = swDmApp.GetDocument(path, docType, readOnly, openDocErr)
    
    If swDmDoc Is Nothing Then
        Err.Raise vbError, "", "Failed to open document: '" & path & "'. Error Code: " & openDocErr
    End If
    
    Set OpenDocument = swDmDoc
    
End Function

Public Function GETSWPRP(fileName As String, prpNames As Variant, Optional confName As String = "") As Variant
    
    Dim swDmApp As SwDocumentMgr.SwDMApplication
    Dim swDmDoc As SwDocumentMgr.SwDMDocument10
    
try_:
    On Error GoTo catch_
    
    Dim vNames As Variant
            
    If TypeName(prpNames) = "Range" Then
        vNames = RangeToArray(prpNames)
    Else
        vNames = Array(CStr(prpNames))
    End If
    
    Set swDmApp = ConnectToDm()
    Set swDmDoc = OpenDocument(swDmApp, fileName, True)
    
    Dim res() As String
    Dim i As Integer
    ReDim res(UBound(vNames))
    
    Dim prpType As SwDmCustomInfoType
    
    If confName = "" Then
        For i = 0 To UBound(vNames)
            res(i) = swDmDoc.GetCustomProperty(CStr(vNames(i)), prpType)
        Next
    Else
        Dim swDmConf As SwDocumentMgr.SwDMConfiguration10
        Set swDmConf = swDmDoc.ConfigurationManager.GetConfigurationByName(confName)
        If Not swDmConf Is Nothing Then
            For i = 0 To UBound(vNames)
                res(i) = swDmConf.GetCustomProperty(CStr(vNames(i)), prpType)
            Next
        Else
            Err.Raise vbError, "", "Failed to get configuration '" & confName & "' from '" & fileName & "'"
        End If
    End If
    
    GETSWPRP = res
    
    GoTo finally_
    
catch_:
    Debug.Print Err.Description
    Err.Raise Err.Number, Err.Source, Err.Description
finally_:
    If Not swDmDoc Is Nothing Then
        swDmDoc.CloseDoc
    End If

End Function

Public Function SETSWPRP(fileName As String, prpNames As Variant, prpVals As Variant, Optional confName As String = "")
    
    Dim swDmApp As SwDocumentMgr.SwDMApplication
    Dim swDmDoc As SwDocumentMgr.SwDMDocument10
    
try_:
    On Error GoTo catch_
    
    If TypeName(prpNames) <> TypeName(prpVals) Then
        Err.Raise vbError, "", "Property name and value must be of the same type, e.g. either range or cell"
    End If
    
    Dim vNames As Variant
    Dim vVals As Variant
        
    If TypeName(prpNames) = "Range" Then
        
        vNames = RangeToArray(prpNames)
        
        vVals = RangeToArray(prpVals)
        
        If UBound(vNames) <> UBound(vVals) Then
            Err.Raise vbError, "", "Number of cells in the name and value are not equal"
        End If
    Else
        vNames = Array(CStr(prpNames))
        vVals = Array(CStr(prpVals))
    End If
    
    Set swDmApp = ConnectToDm()
    Set swDmDoc = OpenDocument(swDmApp, fileName, False)
    
    Dim i As Integer
    
    If confName = "" Then
        For i = 0 To UBound(vNames)
            swDmDoc.AddCustomProperty CStr(vNames(i)), swDmCustomInfoText, CStr(vVals(i))
            swDmDoc.SetCustomProperty CStr(vNames(i)), CStr(vVals(i))
        Next
    Else
        Dim swDmConf As SwDocumentMgr.SwDMConfiguration10
        Set swDmConf = swDmDoc.ConfigurationManager.GetConfigurationByName(confName)
        
        If Not swDmConf Is Nothing Then
            For i = 0 To UBound(vNames)
                swDmConf.AddCustomProperty CStr(vNames(i)), swDmCustomInfoText, CStr(vVals(i))
                swDmConf.SetCustomProperty CStr(vNames(i)), CStr(vVals(i))
            Next
        Else
            Err.Raise vbError, "", "Failed to get configuration '" & confName & "' from '" & fileName & "'"
        End If
    End If
    
    swDmDoc.Save
    
    SETSWPRP = "OK"
    
    GoTo finally_
    
catch_:
    Debug.Print Err.Description
    Err.Raise Err.Number, Err.Source, Err.Description
finally_:
    If Not swDmDoc Is Nothing Then
        swDmDoc.CloseDoc
    End If
    
End Function

Private Function RangeToArray(vRange As Variant) As Variant
    
    If TypeName(vRange) = "Range" Then
        Dim excelRange As Range
        Set excelRange = vRange
        
        Dim i As Integer
        
        Dim valsArr() As String
        ReDim valsArr(excelRange.Cells.Count - 1)
        
        i = 0
        
        For Each cell In excelRange.Cells
            valsArr(i) = cell.Value
            i = i + 1
        Next
        
        RangeToArray = valsArr
        
    Else
        Err.Raise vbError, "", "Value is not a Range"
    End If
    
End Function



My key is in this form:

"Nom: swdocmgr_general-0000," & _
"swdocmgr_previews-0000," & _
"swdocmgr_dimxpert-0000," & _
"swdocmgr_geometry-0000," & _
"swdocmgr_xml-0000," & _
"swdocmgr_tessellation-0000"

The 2 libraries are missing but that doesn't solve the error:
image

Kind regards.

Hello

I'm away today, I'll see tomorrow if I have availability if no one has been there before

1 Like

Hello
It seems to me that "Microsoft Excel 15.0 Object Library" corresponds to the 2013 version of Excel which, if this is indeed the case, is not compatible with the Solidworks 2021 that you seem to have.
Kind regards

3 Likes

Hello;
The mentioned error is commented out (ActiveX...) here.

Kind regards.

3 Likes

Hello
So I hadn't read the basic article in its entirety. So I'm leaning towards an incompatibility of Office. Probably supplements that do not exist in 2013.

2 Likes

Hello
I'm coming back after wanting to test on my document manager side and so I think your problem is related to your key.
I had forgotten to put the beginning of the key that corresponds to the name of my company and I had this active error x.
Probably the same thing for you, you have to take all the key transmitted by SW which is normally coded as follows: CompanyName :swdocmgr_general-00000-{31 times}

Hello

I have a similar project to change SW properties from EXCEL.
As all the guys in my company must be able to use the same excel template:

  • Can we do the same thing without entering the SW key?
  • If not, if I use my key, will it work for other workstations/collaborators?

Thank you in advance.

JnO

Hello;

I would say that it all depends on the extent of the properties to be modified...
Technically it is possible to go through Excel + Macro VBA but the use of a common template seems "curious" to me in the context of modifications.
(See tutorial: Using Microsoft Excel with the SolidWorks API - SOLIDWORKS API, PDM API, Onshape FeatureScript, Onshape API Training and Services)
(in English)

For Document Manager keys:
One key per workstation (which must be updated with each Solidworks version update)

I would direct you more towards tools such as "Integration" (Visiativ) or "Cad+" ( xarial.com) or #TASK (Central Innovation), because even if you have to spit in the basinet, the overall gain in productivity is considerable in most cases.

Kind regards.

3 Likes

I have a somewhat specific need indeed. We work together but on different projects.
I created a tool to export BOMs from SW in an excel file that opens automatically and contains macros to reorganize the BOM for purchases.
We often encounter property errors when rereading excel files, and each time you have to reopen the 3D to modify some properties and keep the 3D up to date, that's why I would like to modify the properties directly from this excel file.

From what I understand, to avoid having to open SW I am forced to use the Document Manager keys, and you need one per user. So my excel file will have to draw the key for each user in a specific folder.

Thank you for this information and have a good weekend!

1 Like

Hello
No. One key is enough. It's about your app.
This is one of the proncipal interests of this API. It allows you to access the properties of SW documents on workstations without the software and therefore without a license.
I have developed a utility to report the characteristics of SW elements in our ERP in the form of an Excel add-in. It is deployed on several workstations in the company without any problem.
You just have to plan to update the API and license every time SW is changed.
Have a nice day.

2 Likes

Do you confirm @remrem ?
Because I chose NOT to get started with the Document Manager following the response of our reseller Solidworks who argued the opposite!
(on the other hand, they are the ones who installed the @Zozo_mp station (he will understand) :crazy_face: (note: I didn't find the Smiley who shoots himself in the head)... so I have doubts now.)

Kind regards.

Yes.
Have you received your key?
Can you do a test on a PC without SW?
I don't have easy access to a PC without SW.