'Description: Macro to Rebuild all configurations of Part Files.

'Please back up your data before use and USE AT OWN RISK

' This macro is provided as is.  No claims, support, refund, safety net, or
' warranties are expressed or implied.  By using this macro and/or its code in
' any way whatsoever, the user and any entities which the user represents,
' agree to hold the authors free of any and all liability.  Free distribution
' and use of this code in other free works is welcome.  If any portion of
' this code is used in other works, credit to the authors must be placed in
' that work within a user viewable location (e.g., macro header).  All other
' forms of distribution (i.e., not free, fee for delivery, etc.) are prohibited
' without the expressed written consent by the authors.  Use at your own risk!

' ------------------------------------------------------------------------------
' Written by: Deepak Gupta (http://gupta9665.com/)
' Edited by Garret Hansen 03/18/2015
' Converted for Task by Garret Hansen 02/13/2018
 borrowed code from MARCO TULIO RAMOS FILHO macro on https://forum.solidworks.com/message/771600
' Revised to work with Parts and assemblies by Garret Hansen on Jan 16, 2020
' -------------------------------------------------------------------------------

Dim swApp               As Object
Dim swModel             As SldWorks.ModelDoc2

Dim nErrors             As Long
Dim nWarnings           As Long
Dim nStatus             As Long
Dim i                   As Long

Dim vault               As Object
Dim FileSystemObj       As Object

#If VBA7 Then
    Private Declare PtrSafe Function SHCreateDirectoryEx Lib "shell32" Alias "SHCreateDirectoryExA" (ByVal hwnd As Long, ByVal pszPath As String, ByVal psa As Any) As Long
    Private Declare PtrSafe Function PathIsRelative Lib "shlwapi.dll" Alias "PathIsRelativeA" (ByVal pszPath As String) As Long
#Else
    Private Declare Function SHCreateDirectoryEx Lib "shell32" Alias "SHCreateDirectoryExA" (ByVal hwnd As Long, ByVal pszPath As String, ByVal psa As Any) As Long
    Private Declare Function PathIsRelative Lib "shlwapi.dll" Alias "PathIsRelativeA" (ByVal pszPath As String) As Long
#End If

' Login to Vault

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")

    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
        Log ("LoginToVault error" & vbCrLf & errname & vbCrLf & errdesc)
    Else
        Log "Error creating file vault interface."
    End If
End Sub

' Check out file from MARCO

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
  
 ' Check in file from MARCO
  
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

' Rebuild Part Models ****************************************************************************

Sub RebuildPartModels(swModel)
    
    Set swApp = CreateObject("SldWorks.Application")
    Set swModel = swApp.ActiveDoc
    
    If swModel Is Nothing Then
    MsgBox "Works only on Part Files!"
    End
    End If
    
    If swModel.GetType <> swDocPART Then
    MsgBox "Please select a Part File!"
    End
    End If
         
    vConfNameArr = swModel.GetConfigurationNames

    For i = 0 To UBound(vConfNameArr)

        sConfigName = vConfNameArr(i)

        bShowConfig = swModel.ShowConfiguration2(sConfigName)
        
        swModel.ForceRebuild3 False

    Next i

    Set swDocXt = swModel.Extension
    If swDocXt.HasDesignTable Then
        Set DesTbl = swModel.GetDesignTable
            dummy = DesTbl.Attach
            dummy = DesTbl.UpdateTable(swDesignTableUpdateOptions_e.swUpdateDesignTableAll, True)
            DesTbl.Detach
    End If
        
        swModel.ForceRebuild3 True
        swModel.Save3 1, nErrors, nWarnings

Set swModel = Nothing

End Sub


Sub main()

    On Error Resume Next

    Set FileSystemObj = CreateObject("Scripting.FileSystemObject")
    
    Call LoginToVault
    
        ' Get docFileName
    
        docFileName = "<Filepath>"
     
    Set swApp = Application.SldWorks
    swApp.Visible = True    'SPR 682792, 538578, 651998
        
        ' Checkout File
        
        Dim strCheckOutFileErrorMessage As String
        strCheckOutFileErrorMessage = CheckOutFile((docFileName))

' Open Part

 Set swModel = swApp.OpenDoc6(docFileName, 1, 0, "", nStatus, nWarnings)

 Call RebuildPartModels(swModel)

    ' Close drawing

     swApp.CloseDoc docFileName

    ' Check In the File
        
     Dim strCheckInFileErrorMessage As String
     strCheckInFileErrorMessage = CheckInFile((docFileName))
        
End Sub