CATIA V5 Tables Extract to Excel

[Yodi.dl]

I have this macro in CATIA to export tables from CATIA to excel based on certain table names. Im having problem with it since it only runs properly if I have an excel open before running it. If i dont have an excel opened it says that the file has been saved but in reality no file has been saved at all. I have provided the code below for your reference. Hope you can help me please.



Sub CATMain()
' Ask for confirmation before running the macro
Dim confirmation As VbMsgBoxResult
confirmation = MsgBox("Are you sure you want to proceed?" & vbNewLine & vbNewLine & "Note: Ensure that table names are renamed as 'bill', 'customer', 'modified', 'ref', or 'removed' for the macro to function correctly", vbYesNo + vbQuestion, "Extract Tables Confirmation")

' If the user selects No, exit the macro
If confirmation = vbNo Then Exit Sub
' Set the CATIA popup file alerts to False
' It prevents the macro from stopping at each alert during its execution
CATIA.DisplayFileAlerts = False

' Global Declarations
Dim totalrows As Integer
Dim totalcolumns As Integer
Dim drwdoc As Document
Dim DrwSheets As DrawingSheets
Dim DrwSheet As DrawingSheet
Dim drwviews As DrawingViews
Dim drwview As DrawingView
Dim drwtables As DrawingTables
Dim drwtable As DrawingTable
Dim objExcel As Object
Dim objWorkbook As Object
Dim objSheet As Object
Dim r As Integer, c As Integer
Dim IsExcelRunning As Boolean


' Set reference to the active drawing document
Set drwdoc = CATIA.ActiveDocument
If TypeName(drwdoc) <> "DrawingDocument" Then
MsgBox "This macro can only be run with a drawing document.", vbInformation, "Document not a Drawing"
Exit Sub
End If


' Set reference to all drawing sheets
Set DrwSheets = drwdoc.Sheets


' Check if Excel is running
On Error Resume Next
Set objExcel = GetObject(, "Excel.Application")
If objExcel Is Nothing Then
IsExcelRunning = False
Else
IsExcelRunning = True
End If
On Error GoTo 0


' Create a new Excel workbook
On Error Resume Next
Set objExcel = GetObject(, "Excel.Application")
If objExcel Is Nothing Then
Set objExcel = CreateObject("Excel.Application")
Err.Clear
objExcel.Visible = False
End If
On Error GoTo 0


' Construct the file path to save on the desktop as XLSX
Dim desktopPath As String
desktopPath = Environ("USERPROFILE") & "\Desktop\" & _
Left(drwdoc.Name, Len(drwdoc.Name) - 11) & ".xlsx"


' Create a new workbook
Set objWorkbook = objExcel.Workbooks.Add()


' Loop through each drawing sheet
For Each DrwSheet In DrwSheets
' Set reference to drawing views
Set drwviews = DrwSheet.Views


' Create a new worksheet for this sheet's tables
Set objSheet = objWorkbook.Sheets.Add(After:=objWorkbook.Sheets(objWorkbook.Sheets.Count))

Dim rowIndex As Integer
rowIndex = 1 ' Start at the first row


' Loop through each drawing view in the sheet
For j = 1 To drwviews.Count
Set drwview = drwviews.Item(j)
Set drwtables = drwview.Tables


' Loop through tables in the view
If drwtables.Count > 0 Then
For k = 1 To drwtables.Count
Set drwtable = drwtables.Item(k)

Dim keywords As String
keywords = "bill customer modified ref removed matrix" ' Add more keywords as needed
keywords = LCase(keywords) ' Convert to lowercase for case-insensitive comparison

Dim tableName As String
tableName = LCase(drwtable.Name)
Dim hasKeywords As Boolean
hasKeywords = False


' Check if any of the keywords is present in the table name
For Each keyword In Split(keywords, " ")
If InStr(tableName, keyword) > 0 Then
hasKeywords = True
Exit For
End If
Next keyword

If hasKeywords Then
' Add table name as separator
objSheet.Cells(rowIndex, 1) = drwtable.Name
objSheet.Cells(rowIndex, 1).HorizontalAlignment = -4108 ' Center align text
rowIndex = rowIndex + 1 ' Move to the next row

totalrows = drwtable.NumberOfRows
totalcolumns = drwtable.NumberOfColumns
Dim table()
ReDim table(totalrows, totalcolumns)
For r = 1 To totalrows
For c = 1 To totalcolumns
table(r, c) = drwtable.GetCellString(r, c)
Next
Next


' Populate the Excel sheet with table data
For r = 1 To totalrows
For c = 1 To totalcolumns
objSheet.Cells(rowIndex, c).NumberFormat = "@" ' Set cell format to text
objSheet.Cells(rowIndex, c) = table(r, c)
objSheet.Cells(rowIndex, c).HorizontalAlignment = -4108 ' Center align text
Next
rowIndex = rowIndex + 1 ' Move to the next row
Next


' Add a blank row separator
rowIndex = rowIndex + 1
End If
Next k ' table loop
End If
Next j ' view loop


' Delete the sheet if it doesn't have tables
If objSheet.UsedRange.Cells.Count <= 1 Then
objSheet.Delete
End If
Next DrwSheet ' sheet loop


' Save the Excel workbook on the desktop as XLSX
objWorkbook.SaveAs Filename:=desktopPath, FileFormat:=51
objWorkbook.Close SaveChanges:=False


' Close Excel if it was opened by the macro
If IsExcelRunning = False Then
If Not objExcel Is Nothing Then
objExcel.Quit
End If
End If


MsgBox "File is saved in your desktop.", vbInformation, "Table Export Complete"
End Sub

 

[weagan22]

In VB.Net this is how I get my interface to Excel.

Function GetExcel(Optional showErr As Boolean = True) As Boolean
        Dim runTest As Boolean = False

        For Each p As Process In Process.GetProcesses()
            If p.ProcessName = "EXCEL" Then
                runTest = True
            End If
        Next

        'Get Excel object
        Try
            If runTest Then
                Excel = GetObject(, "Excel.Application")
            Else
                Excel = CreateObject("Excel.Application")
            End If

            Excel.Visible = True

        Catch
            If showErr Then
                Me.Hide()
                MsgBox("Failed to get Excel object.",, "Error")
                Me.Show()
            End If

            Return False
        End Try

        Return True
End Function