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