9 Replies Latest reply on Mar 4, 2018 8:01 PM by Tim Webb

    Run a SolidWorks Macro (.swp) in PDM transition

    Jonathan Westcott

      I have a standard SolidWorks macro that I'm trying to get to run during a PDM task but can't seem to get it to work. I keep getting the error

       

      2018-03-04 13_56_12-Task Details.png

       

      I've set that task to run on the computer it was launched and am running as admin so will have permissions.

      I'm guessing that I've done something wrong in way I'm calling the macro after checking out the file in the vault it out in the vault.

      The RunMacro2 code runs in the SolidWorks environment.

      I just don't really get the VB.NET bit.

      I've tried to adapt the code form this other thread https://forum.solidworks.com/thread/209804 but think I've probably just made a mess haha.

       

      Any ideas would be very much appreciated.

       

      Code below.

       

      Option Explicit On

       

      Dim swApp As Object

      Dim swModel As SldWorks.ModelDoc2

      Dim errors As Long

      Dim warnings As Long

      Dim FileSystemObj As Object

      Dim swModExt As SldWorks.ModelDocExtension

      Dim Vault As Object

      Dim vViews As Variant

      Dim i As Integer

      Dim swApp As SldWorks.SldWorks

      Dim boolstatus As Boolean

      Dim runMacroError As Long

       

       

      #If VBA7 Then

      Private Declare PtrSafe Function GetLongPathName Lib "kernel32" Alias "GetLongPathNameA" (ByVal lpszShortPath As String, ByVal lpszLongPath As String, ByVal cchBuffer As Long) As Long

      Private Declare PtrSafe Function LoadLibrary Lib "kernel32" Alias "LoadLibraryA" (ByVal lpLibFileName As String) As Long

      Private Declare PtrSafe Function GetProcAddress Lib "kernel32" (ByVal hModule As Long, ByVal lpProcName As String) As Long

      Private Declare PtrSafe Function FreeLibrary Lib "kernel32" (ByVal hLibModule As Long) As Long

      Private Declare PtrSafe Function GetTempPath Lib "kernel32" Alias "GetTempPathA" (ByVal nBufferLength As Long, ByVal lpBuffer As String) As Long

         

      #Else

      Private Declare Function GetLongPathName Lib "kernel32" Alias "GetLongPathNameA" (ByVal lpszShortPath As String, ByVal lpszLongPath As String, ByVal cchBuffer As Long) As Long

      Private Declare Function LoadLibrary Lib "kernel32" Alias "LoadLibraryA" (ByVal lpLibFileName As String) As Long

      Private Declare Function GetProcAddress Lib "kernel32" (ByVal hModule As Long, ByVal lpProcName As String) As Long

      Private Declare Function FreeLibrary Lib "kernel32" (ByVal hLibModule As Long) As Long

      Private Declare Function GetTempPath Lib "kernel32" Alias "GetTempPathA" (ByVal nBufferLength As Long, ByVal lpBuffer As String) As Long

      #End If

       

      Sub RunMacro(docFileName)

          Call LoginToVault()

       

          Dim strCheckOutFileErrorMessage As String

          strCheckOutFileErrorMessage = CheckOutFile((docFileName))

       

          boolstatus = swApp.RunMacro2("D:\Prefix Custom Properties (sldprt & sldasm).swp", "Prefix", "main", swRunMacroUnloadAfterRun, runMacroError)

          swModel.Save3 swSaveAsOptions_Silent, errors, warnings

          swApp.QuitDoc swModel.GetTitle

       

          Dim strCheckInFileErrorMessage As String

          strCheckInFileErrorMessage = CheckInFile((docFileName))

       

      End Sub

       

      Private Sub LoginToVault()

          On Error GoTo ErrHand

          Dim strTempVaultName As String

          Dim strVaultName As String

       

       

          strTempVaultName = "<VaultPath>"

          i = Len(strTempVaultName)

          j = InStrRev(strTempVaultName, "\")

          strVaultName = Right(strTempVaultName, i - j)

       

       

      Set Vault = CreateObject("ConisioLib.EdmVault.1")

      Vault.LoginAuto strVaultName, 0

      Exit Sub

       

       

      ErrHand:

          If Not Vault Is Nothing Then

              Dim ErrName As String

              Dim ErrDesc As String

              Vault.GetErrorString Err.Number, ErrName, ErrDesc

      MsgBox "Could not open file vault." + vbLf + ErrName + vbLf + ErrDesc

      'ErrorOut "Could not open file vault.", errorFilePath

          Else

              MsgBox "Error creating file vault interface."

      End If

      End Sub

       

      Private Function CheckOutFile(strFileName As String) As String

       

          On Error GoTo ErrHand

          Dim folder As Object

          Dim folderPath As String

          Dim FolderPath1 As String

          folderPath = strFileName

          j = InStrRev(folderPath, "\")

          FolderPath1 = Left(folderPath, j)

      Set folder = Vault.GetFolderFromPath(FolderPath1)

      i = Len(strFileName)

          j = InStrRev(strFileName, "\")

          FileName = Right(strFileName, i - j)

          Dim file As Object

          Dim oNull As Object

      Set file = folder.GetFile(FileName)

      If file Is Nothing Then

              'MsgBox "File not found."

              Exit Function

          End If

       

          file.LockFile folder.ID, 0

      CheckOutFile = "Successful"

          Exit Function

       

      ErrHand:

          Dim ename As String

          Dim edesc As String

          Vault.GetErrorString Err.Number, ename, edesc

      CheckOutFile = edesc

          'MsgBox ename + vbLf + edesc

      End Function

       

      Private Function CheckInFile(strFileName As String) As String

          On Error GoTo ErrHand

          Dim file As Object

          Dim oNull As Object

      Set file = Vault.GetFileFromPath(strFileName, oNull)

      If file Is Nothing Then

              'MsgBox "File not found."

              Exit Function

          End If

          file.UnlockFile 0, "The file was checked in!"

      CheckInFile = "Successful"

          Exit Function

      ErrHand:

          Dim ename As String

          Dim edesc As String

          Vault.GetErrorString Err.Number, ename, edesc

      CheckInFile = edesc

          'MsgBox ename + vbLf + edesc

      End Function

       

       

      Sub main()

          Set FileSystemObj = CreateObject("Scripting.FileSystemObject")

          docFileName = "<Filepath>"

          Set swApp = Application.SldWorks

          swApp.Visible = True

          RunMacro docFileName

          Exit Sub

       

      End Sub