BOM to FileExcel - Demonstration with Api.

'-----------------------------------------------------------
'Bom to FileExcel. '
' Autor: Ing.Sup.Mec. Pedro Omar Sánchez Curbelo (swPeter) '
' Sevilla. Spain. 27 July 2005 '
'-----------------------------------------------------------

Option Explicit

' PasteSpecial of Excel
'Public Const xlPasteSpecialOperationAdd = 2
'Public Const xlPasteAll = -4104

' Used to be TYPE_DRAWING
Public Const swDocDRAWING = 3

Public swViewBOM As SldWorks.BomTable 'Object '
Public nNumRow As Long
Public nNumCol As Long

Public xlsApp As Object 'Excel.Application '

Sub main()

Dim swApp As SldWorks.SldWorks 'Object '
Dim swModel As SldWorks.ModelDoc2 'Object '
Dim swDraw As SldWorks.DrawingDoc 'Object '
Dim swView As SldWorks.View 'Object '
Dim swView_Name As String
Dim bRet As Boolean
Dim I As Long
Dim sPathName As String
Dim nPos As Long
Dim sfolderDoc As String
Dim NewBook As Object 'Excel.Workbook '
Dim ObjRange As Object 'Excel.Range '
Dim FileBOM As Boolean
Dim ObjExcel As Object
Dim Fs As Object
Dim iRet As Integer

Set swApp = GetObject(, "SldWorks.Application")
If Not swApp Is Nothing Then
Set swModel = swApp.ActiveDoc
If Not swModel Is Nothing Then
If swModel.GetType = swDocDRAWING Then
sPathName = swModel.GetPathName
If sPathName <> "" Then
nPos = InStrRev(sPathName, ".")
sfolderDoc = Left$(sPathName, nPos - 1)
Set swDraw = swModel
Set swView = swDraw.GetFirstView
Set swView = swView.GetNextView
Do While Not swView Is Nothing
swView_Name = swView.Name
bRet = swModel.Extension.SelectByID2(swView_Name, "DRAWINGVIEW",
0, 0, 0, False, 0, Nothing, 0)
If bRet <> False Then
Set swViewBOM = swView.GetBomTable
If Not swViewBOM Is Nothing Then
If AttachBOM Then
Set NewBook = xlsApp.Workbooks.Add
If Not NewBook Is Nothing Then
I = I + 1
NewBook.SaveAs sfolderDoc & "_BOM " & CStr(I) & ".xls"
Set ObjRange =
NewBook.Sheets(1).Range(NewBook.Sheets(1).Cells(1, 1),
NewBook.Sheets(1).Cells(nNumRow, nNumCol))
ObjRange.PasteSpecial 'xlPasteAll,
xlPasteSpecialOperationAdd, 0, 0
Set ObjRange = Nothing
NewBook.Save
NewBook.Close
Set NewBook = Nothing
Set xlsApp = Nothing
FileBOM = True
End If
End If
End If
End If
Set swView = swView.GetNextView
Loop
Set swView = Nothing
Set swDraw = Nothing
Set swModel = Nothing
Else
MsgBox "First save this document"
End If
Else
MsgBox "Only Allowed on document DRAWs"
End If
Else
MsgBox "There is no active document"
End If
Set swApp = Nothing
Else
MsgBox "It was not possible to be connected with SolidWorks"
End If

If FileBOM Then
Set Fs = CreateObject("Scripting.FileSystemObject")
If Not Fs Is Nothing Then
If Fs.FileExists(sfolderDoc & "_BOM " & CStr(I) & ".xls") Then
iRet = MsgBox("Do you want to open the generated file?", vbQuestion
Or vbYesNo, "swPeter")
If iRet = vbYes Then
Set ObjExcel = GetObject(sfolderDoc & "_BOM " & CStr(I) & ".xls")
ObjExcel.Application.Visible = True
ObjExcel.Parent.Windows(1).Visible = True
Set ObjExcel = Nothing
Else
MsgBox "Good luck and Health. Good bye. ", vbInformation,
"swPeter"
End If
End If
Set Fs = Nothing
End If
End If

End Sub

Public Function AttachBOM() As Boolean

Dim xlsWB As Object 'Excel.Workbook '
Dim xlsSht As Object 'Excel.Worksheet '
Dim ObjRange As Object 'Excel.Range '


If swViewBOM.Attach3 Then
nNumRow = swViewBOM.GetTotalRowCount
nNumCol = swViewBOM.GetTotalColumnCount
Set xlsApp = GetObject(, "Excel.Application")
If Not xlsApp Is Nothing Then
Set xlsWB = xlsApp.ActiveWorkbook
If Not xlsWB Is Nothing Then
Set xlsSht = xlsWB.Sheets(1)
If Not xlsSht Is Nothing Then
Set ObjRange = xlsWB.Sheets(1).Range(xlsWB.Sheets(1).Cells(1, 1),
xlsWB.Sheets(1).Cells(nNumRow, nNumCol))
If Not ObjRange Is Nothing Then
ObjRange.Copy
Set ObjRange = Nothing
AttachBOM = True
End If
Set xlsSht = Nothing
Else
MsgBox "Error attacking the Sheet in Excel"
End If
Set xlsWB = Nothing
Else
MsgBox "There is no active Workbook"
End If
'Set xlsApp = Nothing
Else
MsgBox "It was not possible to be connected with Excel"
End If
swViewBOM.Detach
Set swViewBOM = Nothing
Else
MsgBox "Error attacking the BOM"
End If


End Function