| pks hatte folgenden Code gepostet, mit dem dieses häufig geschilderte Problem gelöst werden kann: Option Explicit
Private Sub Command1_Click()
Dim Rs As ADODB.Recordset
Dim ExcelFile As String, Tabelle As String
ExcelFile = "c:\test\graz.xls"
Tabelle = "Tabelle1"
Set Rs = ExcelSheet2Recordset(ExcelFile, Tabelle)
With ListView1
.View = lvwReport
.LabelEdit = lvwManual
.GridLines = True
.FullRowSelect = True
End With
ListViewFillFromRs Rs, ListView1, , False
Set Rs = Nothing
End Sub
Public Function ExcelSheet2Recordset(ExcelFile As String, _
Tabelle As String) _
As ADODB.Recordset
Dim Cn As ADODB.Connection
Dim Rs As ADODB.Recordset
Dim myTab As String
Dim i As Long
Set Cn = New ADODB.Connection
With Cn
.CursorLocation = adUseClient
.Mode = adModeShareDenyNone
.Provider = "Microsoft.Jet.OLEDB.4.0"
.ConnectionString = "Data Source=" & ExcelFile & _
";Extended Properties=Excel 8.0"
.Open
End With
Set Rs = New ADODB.Recordset
myTab = "[" & Tabelle & "$]"
With Rs
.CursorLocation = adUseClient
.CursorType = adOpenKeyset
.LockType = adLockReadOnly
.ActiveConnection = Cn
.Open "Select * From " & myTab
End With
Set Rs.ActiveConnection = Nothing
Cn.Close
Set Cn = Nothing
Set ExcelSheet2Recordset = Rs
Set Rs = Nothing
End Function
Public Sub ListViewFillFromRs(Rs As ADODB.Recordset, Lvw As ListView, _
Optional ID_FieldNumber As Long = -1, _
Optional OnlySubItems As Boolean = True)
Dim i As Long
Dim Li As ListItem
With Lvw
.ColumnHeaders.Clear
.ListItems.Clear
If OnlySubItems Then
.ColumnHeaders.Add , , , 0
End If
For i = 0 To Rs.Fields.Count - 1
.ColumnHeaders.Add , , Rs.Fields(i).Name
Next
Rs.MoveFirst
Do While Not Rs.EOF
Set Li = .ListItems.Add
If ID_FieldNumber >= 0 Then
Li.Key = ID_FieldNumber & "x"
End If
If Not OnlySubItems Then
Li.Text = Rs.Fields(0).Value & vbNullString
End If
If OnlySubItems Then
For i = 0 To Rs.Fields.Count - 1
Li.SubItems(i + 1) = Rs.Fields(i).Value & vbNullString
Next
Else
For i = 1 To Rs.Fields.Count - 1
Li.SubItems(i) = Rs.Fields(i).Value & vbNullString
Next
End If
Rs.MoveNext
Loop
End With
End Sub Listing 1: Excel-Tabelle als textdatei abspeichern Nach dem Aufruf von "ExcelSheet2Recordset" hat man ein Recordset, welches man in eine Datei schreiben kann. |