Hi Folks,

I am working on a master properties macro, and I am running into a limitation of the macro with parts/assemblies that were forgotten to be checked out (PDM Pro). If you forget to check out the part before you run the main macro, there are values that are not saved upon closing the macro and you will have to reenter the values after the part/assembly is check out.

So, my next addition to the macro is to add a check out button to this master properties macro. I have been able to check out the file from Solidworks, but I am running into the issue with the window in Solidworks still says "read only" after check out. My thought to get around this, is to use the multi user environment option and toggle the system property and some how then toggle the get write access command. And this is my hang up. I have been able to do everything but get the get write access command to work. 

I have tired going down the path with SetReadOnly method, but I am hitting Error 438 and not sure how to fix this.  Is this the better route over multi user enviorment?

Here is the Macro I have so far:

Const VAULT_NAME As String = "EBVault"

Dim swApp As SldWorks.SldWorks
Dim swPdmVault As IEdmVault5
Dim check As Boolean
Dim Value As Boolean
'Dim instance As swCommands_e

Sub main()

Set swApp = Application.SldWorks
 
Dim swModel As SldWorks.ModelDoc2
 
Set swModel = swApp.ActiveDoc
 
If Not swModel Is Nothing Then
 
Set swPdmVault = New EdmVault5
swPdmVault.LoginAuto VAULT_NAME, 0
 
If swPdmVault.IsLoggedIn Then
CheckOutModel swModel, swPdmVault
Else
MsgBox "Please login to vault"
End If
 
Else
MsgBox "Please open the model"
End If
 
End Sub

Sub CheckOutModel(model As SldWorks.ModelDoc2, vault As IEdmVault5)

Dim modelPath As String
modelPath = model.GetPathName()
 
Dim swPdmFile As IEdmFile5
Set swPdmFile = vault.GetFileFromPath(modelPath)
Set swApp = Application.SldWorks

If Not swPdmFile Is Nothing Then
 
On Error GoTo catch

Dim res As Boolean
 
Dim swPdmFolder As IEdmFolder5
Set swPdmFolder = vault.GetFolderFromPath(Left(modelPath, InStrRev(modelPath, "\")))

try:
model.ForceReleaseLocks
swPdmFile.LockFile swPdmFolder.ID, 0
res = True
GoTo finally
catch:
Debug.Print Err.Number & ": "; Err.Description
res = False
GoTo finally
 
finally:
model.ReloadOrReplace Not res, modelPath, Not res

Else
Err.Raise vbError, "", "Specified model doesn't exist in the vault"
End If
 
Dim instance As IModelDoc2
Dim SetReadOnly As Boolean
 
'SetReadOnly = False
'Value = instance.SetReadOnlyState(SetReadOnly)
 
swApp.SetUserPreferenceToggle swUserPreferenceToggle_e.swCollabEnableMultiUser, True
swApp.SetUserPreferenceToggle swUserPreferenceToggle_e.swCollabAddShortcutMenuItems, True
'swCommands_Change_Write_Access
'swCommands_Change_Write_Access_Comp
 
 
End Sub

Thanks for any help!