Home > other >  Excel.Application not closed excel file
Excel.Application not closed excel file

Time:12-17

I want to read some data from excel file and close it. but my code not closed it:

Function getColumnOfFirstRow(PATH, size) As Long

Dim oApp_Excel As Excel.Application
Dim oBook As Excel.Workbook
Dim column As Long
column = 0

Set oApp_Excel = CreateObject("EXCEL.APPLICATION")
oApp_Excel.DisplayAlerts = False
oApp_Excel.Visible = True
Set oBook = oApp_Excel.Workbooks.Open(PATH, ReadOnly:=True)

On Error GoTo errhand
column = oBook.Sheets("Sheet1").Cells.Find(What:=CStr(size)).column


oBook.Close True
oApp_Excel.Quit


Set oBook = Nothing

errhand:
    Select Case Err.Number
    Case 91
        column = 0
    End Select
getColumnOfFirstRow = column


End Function

I think this part of my code must close it:

oBook.Close True
oApp_Excel.Quit

CodePudding user response:

Using a New Instance of Excel

  • It looks like overkill to open and close Excel and a workbook to just retrieve a number but let's say we're practicing handling objects and error handling.
Function GetSizeColumn(ByVal Path As String, ByVal Size As Double) As Long

    On Error GoTo ClearError
    
    Dim xlApp As Excel.Application: Set xlApp = New Excel.Application
    xlApp.Visible = True ' out-comment when done testing
    
    Dim wb As Excel.Workbook
    Set wb = xlApp.Workbooks.Open(Path, True, True)
    
    Dim SizeColumn As Long
    SizeColumn = wb.Sheets("Sheet1").Rows(1).Find(CStr(Size)).Column
    ' You can avoid the expected error as you have learned in your newer post. 
    ' In this case, if the error occurs, the function will end up with 
    ' its initial value 0 since its result is declared 'As Long'
    ' i.e. the following line will never be executed.
    
    GetSizeColumn = SizeColumn

ProcExit:
    On Error Resume Next
        If Not wb Is Nothing Then wb.Close False
        If Not xlApp Is Nothing Then xlApp.Quit
    On Error GoTo 0
    Exit Function    
ClearError:
    Debug.Print "Run-time error '" & Err.Number & "':" & vbLf & Err.Description
    Resume ProcExit
End Function

CodePudding user response:

Try it. 100% working code about creating the excel. In this code, excel converts recordset in excel successfully. After that close the excel successfully. No error.

Also, check with the Task manager and close any excel file open in the process.

Public Sub ConvertRecordSetToExcelFull(Rs As Recordset, _
                                   FileNameWithPath As String, _
                                   SheetName As String, _
                                   Rangename As String)

On Error GoTo Error1

Dim ExlFile As Object, Book As Object, Sheet As Object, K As Long, J As Long

Set ExlFile = CreateObject("Excel.Application")
Set Book = ExlFile.Workbooks.Add
Set Sheet = Book.Worksheets(1)
ExlFile.DisplayAlerts = False
K = 1

For J = 0 To Rs.Fields.Count - 1
    Sheet.Cells(K, J   1) = UCase(Rs.Fields(J).Name)
Next
K = K   1

If Rs.RecordCount >= 1 Then

    'Call RecCount(rs)
    Do While Rs.EOF <> True

        For J = 0 To Rs.Fields.Count - 1
            Sheet.Cells(K, J   1) = Rs.Fields(J)
        Next
        K = K   1
        Rs.MoveNext
    Loop

End If

Book.Worksheets(1).Name = SheetName
Book.SaveAs FileNameWithPath
ExlFile.ActiveWorkbook.Close False
ExlFile.Quit
Set Sheet = Nothing
Set ExlFile = Nothing
Screen.MousePointer = vbNormal
Exit Sub
Error1:
MsgBox Err.Description
Err.Clear
End Sub
  • Related