Workbooks.Open Filename:="C:\temp\test.xls"
Application.ScreenUpdating = False
' **********************************************************************
' Modul: Modul1 Typ: Allgemeines Modul
' **********************************************************************
Option Explicit
Sub test()
Dim strFile As String, strTab As String, strRef As String
strFile = "E:\Forum\letzteZeile.xlsx" 'Datei
strTab = "Tabelle1" 'Tabelle
strRef = "A:A" 'Bereich
MsgBox lastRowClosedFile(strFile, strTab, strRef)
End Sub
Private Function lastRowClosedFile(FileName As String, SheetName As String, TargetRange As String) As Long
Dim objADO As Object
On Error Resume Next
Set objADO = ExcelTable(FileName, SheetName, TargetRange)
lastRowClosedFile = objADO.RecordCount + 1
objADO.Close
End Function
Private Function ExcelTable(ByRef Path As String, ByRef Table As String, ByRef SourceRange As String) As Object
Dim SQL As String
Dim Con As String
SQL = "select * from [" & Table & "$" & SourceRange & "]"
If Mid(Path, InStrRev(Path, ".") + 1) = "xls" Then
Con = "Provider=Microsoft.Jet.OLEDB.4.0;" _
& "Extended Properties=Excel 8.0;" _
& "Data Source=" & Path & ";"
ElseIf Mid(Path, InStrRev(Path, ".") + 1) Like "xls?" Then
Con = "Provider=Microsoft.ACE.OLEDB.12.0;" _
& "Extended Properties=""Excel 12.0;HDR=YES"";" _
& "Data Source=" & Path & ";"
Else
Exit Function
End If
Set ExcelTable = CreateObject("ADODB.Recordset")
ExcelTable.Open SQL, Con, 3, 1
End Function
' **********************************************************************
' Modul: Modul1 Typ: Allgemeines Modul
' **********************************************************************
Option Explicit
Sub test()
Dim strFile As String, strTab As String, strRef As String
strFile = "E:\Forum\letzteZeile.xlsx" 'Datei
strTab = "Tabelle1" 'Tabelle
strRef = "A:A" 'Bereich
MsgBox lastCellClosedFileValue(strFile, strTab, strRef)
End Sub
Private Function lastCellClosedFileValue(FileName As String, SheetName As String, TargetRange As String) As Variant
Dim objADO As Object
Dim lngCount As Long
On Error Resume Next
Set objADO = ExcelTable(FileName, SheetName, TargetRange)
With objADO
lngCount = .RecordCount
.Move lngCount - 1
lastCellClosedFileValue = .Fields(0)
.Close
End With
Set objADO = Nothing
End Function
Private Function ExcelTable(ByRef Path As String, ByRef Table As String, ByRef SourceRange As String) As Object
Dim SQL As String
Dim Con As String
SQL = "select * from [" & Table & "$" & SourceRange & "]"
If Mid(Path, InStrRev(Path, ".") + 1) = "xls" Then
Con = "Provider=Microsoft.Jet.OLEDB.4.0;" _
& "Extended Properties=Excel 8.0;" _
& "Data Source=" & Path & ";"
ElseIf Mid(Path, InStrRev(Path, ".") + 1) Like "xls?" Then
Con = "Provider=Microsoft.ACE.OLEDB.12.0;" _
& "Extended Properties=""Excel 12.0;HDR=YES"";" _
& "Data Source=" & Path & ";"
Else
Exit Function
End If
Set ExcelTable = CreateObject("ADODB.Recordset")
ExcelTable.Open SQL, Con, 3, 1
End Function