For some reason, the code does not recognize that a table exists in the assembly and it will not read the contents...
What am I missing?
Const sLicenseKey As String = "*"
Dim swClassFact As SwDocumentMgr.SwDMClassFactory
Dim swDocMgr As SwDocumentMgr.SwDMApplication
Sub ExtractBOMIntoExcel(AssyPath As String, config As String)
Dim vtbls As Variant
Dim tbl As SwDMTable3
Dim doc As SwDMDocument14
Dim xlapp As Excel.Application
Dim xlwb As Excel.Workbook
Dim xlws As Excel.Worksheet
Dim irows As Integer
Dim icols As Integer
'On Error Resume Next
Set swClassFact = New SwDocumentMgr.SwDMClassFactory
Set swDocMgr = swClassFact.GetApplication(sLicenseKey)
Set doc = swDocMgr.GetDocument(AssyPath, swDmDocumentAssembly, True, swDmDocumentOpenErrorNone)
Set vtbls = doc.GetTableNames(swDmTableTypeBOM)
If vtbls Is Nothing Then
InsertIndentedBOM (config)
vtbls = doc.GetTableNames(swDmTableTypeBOM)
End If
vtbls = doc.GetTableNames(swDmTableTypeBOM)
Set tbl = doc.GetTable(vtbls(UBound(vtbls)))
irows = tbl.GetRowCount
icols = tbl.GetColumnCount
Set xlapp = CreateObject("Excel.Application")
Set xlwb = xlapp.Workbooks.Add
Set xlws = xlwb.ActiveSheet
xlapp.Visible = True
Dim i, inc As Integer
Dim strout As String
Dim celltxt As String
Dim strbom As String
For i = 0 To irows - 1
For inc = 0 To icols
strout = tbl.GetCellText(i, inc, celltxt)
Select Case strout
Case SwDmTableErrorNone
'strbom = strbom & vbTab & celltxt
xlws.Cells(i + 1, inc + 1).Value = celltxt
Case SwDmTableErrorFailed
Case SwDmTableErrorNotSupported
End Select
Next
strbom = strbom & vbCrLf
Next
xlws.Range("A:A").NumberFormat = "@"
xlws.Range("B:B").NumberFormat = "@"
xlws.Range("C:C").NumberFormat = "@"
xlws.Range("D:D").NumberFormat = "@"
xlws.Range("E:E").NumberFormat = "@"
xlws.Range("F:F").NumberFormat = "@"
xlws.Range("G:G").NumberFormat = "@"
xlws.Range("H:H").NumberFormat = "@"
xlws.Range("I:I").NumberFormat = "@"
xlws.Range("J:J").NumberFormat = "@"
xlws.Range("K:K").NumberFormat = "@"
xlws.Range("L:L").NumberFormat = "@"
xlws.Range("M:M").NumberFormat = "@"
xlws.Range("N:N").NumberFormat = "@"
xlws.Range("O:O").NumberFormat = "@"
xlws.Range("P:P").NumberFormat = "@"
xlws.Range("A1").Value = "ITEM"
xlws.Range("B1").Value = "QTY"
xlws.Range("C1").Value = "File Name"
xlws.Range("D1").Value = "Configuration Name"
xlws.Range("E1").Value = "Revision"
xlws.Range("F1").Value = "DESCRIPTION"
xlws.Range("G1").Value = "Department"
xlws.Range("H1").Value = "Material"
xlws.Range("I1").Value = "Gauge"
xlws.Range("J1").Value = "Length"
xlws.Range("K1").Value = "Width"
xlws.Range("L1").Value = "Diameter"
xlws.Range("M1").Value = "Height"
xlws.Range("N1").Value = "Stocked"
xlws.Range("O1").Value = "StockedPartNumber"
xlws.Range("P1").Value = "PARTDESTINATION"
End Sub
