PADS Logic BOM Output

Dim fn As StringSub Main fn = ActiveDocument If fn = "" Then fn = "Untitled" End If tempFile = DefaultFilePath & "\temp.txt" Open tempFile For Output As #1 item = 0 StatusBarText = "Generating report..." Print #1, "ITEM";vbTab;"Part Type"; vbTab;"P/N_1"; vbTab;"Manufacturer_1_P/N"; vbTab;"Description"; vbTab;"Manufacturer_1"; vbTab; "Value"; vbTab; "QTY"; vbTab; "REF-DES" For Each pkg in ActiveDocument.PartTypes 'Print #1, pkg.Name; vbTab; note qty = 0 value = "" description = "" manufacturer = "" pn = "" manufacturerpn = "" symbol = "" item = item + 1 'Print #1, item; vbTab; For Each part In pkg.Components value = AttrValue(part, "Value") description = AttrValue(part, "Description") manufacturer = AttrValue(part, "Manufacturer_1") pn = AttrValue(part, "P/N_1") value = AttrValue(part, "Value") manufacturerpn = AttrValue(part, "Manufacturer_1_P/N") sysid = AttrValue(part, "SYSID") qty = qty+1 symbol = symbol + part.Name + ", " Next symbol_len = Len(symbol) symbol = Mid(symbol,1, symbol_len - 2) Print #1, item; vbTab; part.PartType ; vbTab; pn ; vbTab;manufacturerpn; vbTab;description; vbTab;manufacturer; vbTab;value; vbTab; qty; vbTab; symbol; Print #1 Next pkg StatusBarText = "" Close #1 ExportToExcelEnd SubSub ExportToExcel FillClipboard Dim xl As Object On Error Resume Next Set xl = GetObject(,"Excel.Application") On Error GoTo ExcelError ' Enable error trapping. If xl Is Nothing Then Set xl = CreateObject("Excel.Application") End If xl.Visible = True xl.Workbooks.Add xl.ActiveSheet.Paste xl.Range("A1:I1").Font.Bold = True xl.Range("A1:I1").NumberFormat = "@" xl.Range("A1:I1").AutoFilter xl.ActiveSheet.UsedRange.Columns.AutoFit 'Output Report Header xl.Rows(1).Insert xl.Rows(1).Cells(1) = Space(1) & "Part Report "& " WWZL-BOM " & " on " & Now xl.Rows(2).Insert xl.Rows(1).Font.bold = True 'Output Design Totals lastRow = xl.ActiveSheet.UsedRange.Rows.Count + 1 xl.Rows(lastRow + 1).Font.bold = True xl.Rows(lastRow + 1).Cells(1) = Space(1) & "Design Part count: " & ActiveDocument.Components.Count xl.Range("A1").Select On Error GoTo 0 ' Disable error trapping. Exit Sub ExcelError: MsgBox Err.Description, vbExclamation, "Error Running Excel" On Error GoTo 0 ' Disable error trapping. Exit SubEnd SubSub FillClipboard StatusBarText = "Export Data To Clipboard..." ' Load whole file to string variable tempFile = DefaultFilePath & "\temp.txt" Open tempFile For Input As #1 L = LOF(1) AllData$ = Input$(L,1) Close #1 'Copy whole data to clipboard Clipboard AllData$ Kill tempFile StatusBarText = ""End SubFunction AttrValue (comp As Object, atrName As String) As String If comp.Attributes(atrName) Is Nothing Then AttrValue = "" Else AttrValue = comp.Attributes(atrName).Value End IfEnd Function