VBA Open Files from Vault, Not Local
I am using Vault Basic. I wrote the program in VB.NET to open from vault. Only now, I am having trouble with distributing. I can publish to exe from Visual Studio 2019, but security blocks the install. I would rather implement as part of my existing VBA utility.
FYI, I started with Visual Studio 2022 and had to uninstall and install 2019 because I could not install the Inventor 2022 SDK until doing so.
Imports Excel = Microsoft.Office.Interop.Excel
Public Class Form1
Private Sub Form1_Load(sender As Object, e As EventArgs) Handles MyBase.Load
Me.ListBox_Parts.Items.Clear()
btnBrowse.Select()
End Sub
Private Sub Button1_Click(sender As Object, e As EventArgs) Handles btnOpenDrawings.Click
If ListBox_Parts.Items.Count < 1 Then
MsgBox("No parts selected")
Exit Sub
End If
Dim x As clsVault
x = New clsVault
Dim parts(49) As String, i As Long
For i = 0 To Me.ListBox_Parts.Items.Count - 1
parts(i) = Me.ListBox_Parts.Items(i)
Next i
x.GetFilesFromList(parts)
End
End Sub
Private Sub btnBrowse_Click(sender As Object, e As EventArgs) Handles btnBrowse.Click
Dim appXL As Excel.Application
Dim wbXl As Excel.Workbook
Dim shXL As Excel.Worksheet
Dim raXL As Excel.Range
' Add a new workbook.
Dim strFile As String = vbNullString
Dim openFile As New OpenFileDialog
openFile.Filter = "Excel files (*.xlsx)|*.xlsx"
openFile.ShowDialog()
If openFile.FileNames().Length = 1 Then
strFile = openFile.FileName
Else
'MsgBox("User Cancelled")
Exit Sub
End If
' Start Excel and get Application object.
appXL = CreateObject("Excel.Application")
appXL.Visible = False
wbXl = appXL.Workbooks.Open(strFile,, True)
shXL = wbXl.ActiveSheet
' Create an array to set multiple values at once.
Dim parts(49) As String
'Me.ListBox_Parts.Items.Clear()
Dim lRow As Long = 0
Dim strText As String = vbNullString
Dim AddedAtLeastOne As Boolean = False
With shXL
For lRow = 0 To 49
strText = vbNullString
strText = .Cells(lRow + 1, 1).Value
parts(lRow) = strText
If strText IsNot vbNullString Then
'Check for duplicate
If Me.ListBox_Parts.Items.Count = 0 Then
Me.ListBox_Parts.Items.Add(strText)
AddedAtLeastOne = True
Else
Dim j As Integer = 0
Dim match As Boolean = False
For j = 0 To Me.ListBox_Parts.Items.Count - 1
If strText = Me.ListBox_Parts.Items(j).ToString Then
match = True
Exit For
End If
Next j
If match = False Then
Me.ListBox_Parts.Items.Add(strText)
AddedAtLeastOne = True
End If
End If
End If
Next
End With
Dim numParts As Long
numParts = Me.ListBox_Parts.Items.Count
'Dim files(49) As String
' Make sure Excel is visible and give the user control
' of Excel's lifetime.
appXL.Visible = True
appXL.UserControl = True
' Release object references.
raXL = Nothing
shXL = Nothing
wbXl = Nothing
appXL.Quit()
appXL = Nothing
If AddedAtLeastOne = True Then
btnOpenDrawings.Select()
Else
MsgBox("No unique parts found in Excel list")
End If
End Sub
Private Sub btnClear_Click(sender As Object, e As EventArgs) Handles btnClear.Click
Me.ListBox_Parts.Items.Clear()
End Sub
Private Sub btnRemove_Click(sender As Object, e As EventArgs) Handles btnRemove.Click
Try
Me.ListBox_Parts.Items.RemoveAt(Me.ListBox_Parts.SelectedIndex)
Catch ex As Exception
MsgBox("None selected")
End Try
End Sub
Private Sub btnAdd_Click(sender As Object, e As EventArgs) Handles btnAdd.Click
Dim myString As String = vbNullString
myString = Me.TextBox_Add.Text
If myString = vbNullString Then
'Nothing to add
Exit Sub
End If
'Check if already added
Dim i As Integer = 0
For i = 0 To Me.ListBox_Parts.Items.Count - 1
If myString = Me.ListBox_Parts.Items(i) Then
MsgBox("Already in list")
Exit Sub
End If
Next i
'Add to list
Me.ListBox_Parts.Items.Add(myString)
Me.TextBox_Add.Text = vbNullString
End Sub
End Class
Imports Inventor
Imports Microsoft.Office.Interop.Excel
Imports Autodesk.DataManagement.Client.Framework.Vault
Imports Autodesk.Connectivity.WebServicesTools
Imports VDF = Autodesk.DataManagement.Client.Framework
Imports ACW = Autodesk.Connectivity.WebServices
Imports System.Collections
Imports System.Linq
Imports System.Windows.Forms
Public Class clsVault
Dim FileIters As System.Collections.Generic.ICollection(Of VDF.Vault.Currency.Entities.FileIteration)
Public Shared myString As String
Public Sub GetFilesFromList(parts() As String)
'LOG IN
Dim results1 As Results.LogInResult = VDF.Vault.Library.ConnectionManager.LogIn("Vault", "ABTEX_Vault", "rcolon", "", VDF.Vault.Currency.Connections.AuthenticationFlags.Standard, Nothing)
If Not results1.Success Then
MsgBox("Error1")
End If
Dim connection As VDF.Vault.Currency.Connections.Connection = Nothing
connection = results1.Connection
'GET INVENTOR
Dim m_inventorApp As Inventor.Application = Nothing
Try
m_inventorApp = System.Runtime.InteropServices.Marshal.GetActiveObject("Inventor.Application")
Catch ex As Exception
MsgBox("Error2")
End Try
Try
If m_inventorApp Is Nothing Then
MsgBox("Error3")
Return
End If
Catch
End Try
m_inventorApp.Visible = True
'''''''''''''''''''''''''''''''''''''''''''''
Dim filePropDefs As ACW.PropDef() =
connection.WebServiceManager.PropertyService.GetPropertyDefinitionsByEntityClassId("FILE")
Dim fileNamePropDef As ACW.PropDef =
filePropDefs.[Single](Function(n) n.SysName = "ClientFileName")
Dim filepaths As New List(Of String)()
Dim files As New List(Of ACW.File)()
Dim part As String = vbNullString
For Each part In parts
If part IsNot Nothing Then
' SrchOper 1 => contains
' SrchOper 3 => equals
Dim fileNameToFind As New ACW.SrchCond() With {
.PropDefId = fileNamePropDef.Id,
.PropTyp = ACW.PropertySearchType.SingleProperty,
.SrchOper = 1,
.SrchRule = ACW.SearchRuleType.Must,
.SrchTxt = part '"C0011A05P008 Guard Rear Bracket" 'part
}
Dim bookmark As String = String.Empty
Dim status As ACW.SrchStatus = Nothing
Dim totalResults As New List(Of ACW.File)()
Dim rslt As ACW.File
While status Is Nothing OrElse totalResults.Count < status.TotalHits
Dim results As ACW.File() =
connection.WebServiceManager.DocumentService.FindFilesBySearchConditions(New ACW.SrchCond() {fileNameToFind}, Nothing, Nothing, False, True, bookmark, status)
If results IsNot Nothing Then
'File(s) found
totalResults.AddRange(results)
For Each rslt In totalResults
If Microsoft.VisualBasic.Right(rslt.Name, 4) = ".idw" Then
'Add to list of file paths
files.Add(rslt)
Dim results2 As ACW.FilePath() = connection.WebServiceManager.DocumentService.FindFilePathsByNameAndChecksum(rslt.Name, rslt.Cksum)
If results2 IsNot Nothing Then
filepaths.Add(results2(0).Path)
End If
End If
Next rslt
Else
Exit While
End If
End While
'connection.WebServiceManager.DocumentService.FindFilePathsByNameAndChecksum()
' total results now has the results
'totalResults.Item(2).FolderId
'totalResults.Item(2).
End If
Next part
''''''''''''''
Dim DocService As ACW.DocumentService
DocService = connection.WebServiceManager.DocumentService
Dim file As ACW.File
'get settings
Dim oSettings As VDF.Vault.Settings.AcquireFilesSettings = New VDF.Vault.Settings.AcquireFilesSettings(connection)
oSettings.DefaultAcquisitionOption = VDF.Vault.Settings.AcquireFilesSettings.AcquisitionOption.Download 'Or VDF.Vault.Settings.AcquireFilesSettings.AcquisitionOption.Checkout
For Each file In files
Dim oFileIteration As VDF.Vault.Currency.Entities.FileIteration = Nothing
oFileIteration = New VDF.Vault.Currency.Entities.FileIteration(connection, file)
Try
If oFileIteration IsNot Nothing Then
oSettings.AddEntityToAcquire(oFileIteration)
myString = "NE"
End If
Catch ex As Exception
Return
Finally
End Try
Next
Try
connection.FileManager.AcquireFiles(oSettings)
Catch ex As Exception
Return
End Try
VDF.Vault.Library.ConnectionManager.LogOut(connection)
Dim filepath As String = vbNullString
For Each filepath In filepaths
filepath = filepath.Replace("$/", "C:\Vault_Workspace\ABTEX_Vault\")
filepath = filepath.Replace("/", "\")
m_inventorApp.Documents.Open(filepath)
Next
m_inventorApp = Nothing
myString = Nothing
End Sub
End Class
Kind regards,
Rafael
INV2022.3 Professional
WIN 10 21H2
I think you would be better off if you changed your application to an Inventor addin. I wrote a tutorial about writing an addin. ("Creating an Inventor Addin" is the start but I think you will find "Adding a form to your addin" also interesting.) Then when you managed that you can start adding all other (VBa) utilities to this addin. The problem with VBa is, that it's obsolete. (Is VBA in Inventor obsolete?) Therefore you will need to convert all your code at some point anyway.
Jelte de Jong
Did you find this post helpful? Feel free to Like this post.
Did your question get successfully answered? Then click on the ACCEPT SOLUTION button.
Blog: hjalte.nl - github.com
