BOM to FileExcel - Demonstration with Api.

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

Option Explicit

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

' Used to be TYPE_DRAWING Public Const swDocDRAWING =3D 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 =3D GetObject(, "SldWorks.Application") If Not swApp Is Nothing Then Set swModel =3D swApp.ActiveDoc If Not swModel Is Nothing Then If swModel.GetType =3D swDocDRAWING Then sPathName =3D swModel.GetPathName If sPathName "" Then nPos =3D InStrRev(sPathName, ".") sfolderDoc =3D Left$(sPathName, nPos - 1) Set swDraw =3D swModel Set swView =3D swDraw.GetFirstView Set swView =3D swView.GetNextView Do While Not swView Is Nothing swView_Name =3D swView.Name bRet =3D swModel.Extension.SelectByID2(swView_Name, "DRAWINGVIEW",

0, 0, 0, False, 0, Nothing, 0) If bRet False Then Set swViewBOM =3D swView.GetBomTable If Not swViewBOM Is Nothing Then If AttachBOM Then Set NewBook =3D xlsApp.Workbooks.Add If Not NewBook Is Nothing Then I =3D I + 1 NewBook.SaveAs sfolderDoc & "_BOM " & CStr(I) & ".xls" Set ObjRange =3D NewBook.Sheets(1).Range(NewBook.Sheets(1).Cells(1, 1), NewBook.Sheets(1).Cells(nNumRow, nNumCol)) ObjRange.PasteSpecial 'xlPasteAll, xlPasteSpecialOperationAdd, 0, 0 Set ObjRange =3D Nothing NewBook.Save NewBook.Close Set NewBook =3D Nothing Set xlsApp =3D Nothing FileBOM =3D True End If End If End If End If Set swView =3D swView.GetNextView Loop Set swView =3D Nothing Set swDraw =3D Nothing Set swModel =3D 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 =3D Nothing Else MsgBox "It was not possible to be connected with SolidWorks" End If

If FileBOM Then Set Fs =3D CreateObject("Scripting.FileSystemObject") If Not Fs Is Nothing Then If Fs.FileExists(sfolderDoc & "_BOM " & CStr(I) & ".xls") Then iRet =3D MsgBox("Do you want to open the generated file?", vbQuestion Or vbYesNo, "swPeter") If iRet =3D vbYes Then Set ObjExcel =3D GetObject(sfolderDoc & "_BOM " & CStr(I) & ".xls") ObjExcel.Application.Visible =3D True ObjExcel.Parent.Windows(1).Visible =3D True Set ObjExcel =3D Nothing Else MsgBox "Good luck and Health. Good bye. ", vbInformation, "swPeter" End If End If Set Fs =3D 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 =3D swViewBOM.GetTotalRowCount nNumCol =3D swViewBOM.GetTotalColumnCount Set xlsApp =3D GetObject(, "Excel.Application") If Not xlsApp Is Nothing Then Set xlsWB =3D xlsApp.ActiveWorkbook If Not xlsWB Is Nothing Then Set xlsSht =3D xlsWB.Sheets(1) If Not xlsSht Is Nothing Then Set ObjRange =3D 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 =3D Nothing AttachBOM =3D True End If Set xlsSht =3D Nothing Else MsgBox "Error attacking the Sheet in Excel" End If Set xlsWB =3D Nothing Else MsgBox "There is no active Workbook" End If 'Set xlsApp =3D Nothing Else MsgBox "It was not possible to be connected with Excel" End If swViewBOM.Detach Set swViewBOM =3D Nothing Else MsgBox "Error attacking the BOM" End If

End Function

Reply to
sacoru
Loading thread data ...

PolyTech Forum website is not affiliated with any of the manufacturers or service providers discussed here. All logos and trade names are the property of their respective owners.