3 Replies Latest reply on Aug 14, 2017 2:48 PM by MARCO TULIO RAMOS FILHO

    Running a macro via PDM Tasks - problems with 'Save As' dialog

    MARCO TULIO RAMOS FILHO

      I'm trying to run a macro to a number of problematic drawing files to repair their views that became hidden. Is a simple macro that check-out the file, open it in SOLIDWORKS, unhide their views, save the file and check-in back to the vault.

      In a normal test environment everything went ok, but when it runs on customer vault this one problem became a nightmare.

      In some files an 'Save As' dialog shows up and the task hangs and resume run only when the user clicks 'Cancel'. I don't know in first place why the 'Save As' dialog shows up and I don't know how to progamatically clicks the cancel button.

       

      The code is the following:

      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 swDraw As SldWorks.DrawingDoc
      Dim swSheet As SldWorks.Sheet
      Dim swView As SldWorks.View
      Dim vViews As Variant
      Dim i As Integer
      
      
      #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 OpenAndRebuild(docFileName)
         Call LoginToVault
         Dim strCheckOutFileErrorMessage As String
         strCheckOutFileErrorMessage = CheckOutFile((docFileName))
         docType = swDocDRAWING
         Set swModel = swApp.OpenDoc6(docFileName, docType, swOpenDocOptions_Silent, "", errors, warnings)
         If errors = swFutureVersion Then
                Log "Document '" & docFileName & "' is future version."
                Exit Sub
         End If
      ' Load failed?
      If swModel Is Nothing Then
      Log "Method call SldWorks::OpenDoc6 for document '" & docFileName & "' failed. Error code " & errors & " returned."
      Exit Sub
      End If
      
      
      Set swDraw = swModel
      Set swSheet = swDraw.GetCurrentSheet
      vViews = swSheet.GetViews
      swModel.ClearSelection2 False
      
      
      For i = 0 To UBound(vViews)
      Set swView = vViews(i)
      swModel.Extension.SelectByID2 swView.Name, "DRAWINGVIEW", 0, 0, 0, True, 0, Nothing, 0
      swModel.UnsuppressView
      Next i
      swModel.ClearSelection2 True
      swModel.Save
      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()
      'debug.assert false
      On Error GoTo Fail:
      Set FileSystemObj = CreateObject("Scripting.FileSystemObject")
      docFileName = "<Filepath>"
      If LCase(Right(docFileName, 7)) = ".slddrw" then
      ' Get SW interface object
      Set swApp = Application.SldWorks
      swApp.Visible = True    'SPR 682792, 538578, 651998
      OpenAndRebuild docFileName
      Exit Sub
      Else
      Exit Sub
      End If   
        
      Fail:
      Log "Error while OpenAndRebuilding file '" & docFileName & "': " & vbCrLf & _
      "An unexpected error occurred while executing the generated script. Script syntax error?" & vbCrLf & _
      "Error number: " & Err.Number & vbCrLf & _
      "Error description: '" & Err.Description & "'" & vbCrLf
      End Sub