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