ADODB Abfrage - nur spezifische Spalten

Guten Abend
ich möchte gern per ADODB Abfrage Daten aus einer anderen Arbeitsmappe abrufen.
Der folgende Code funktioniert mit dem query = "Select * from [Dienst$]" nicht, da nur maximal 255 Felder bzw. Spalten abgerufen werden. Die Quelltabelle enthält jedoch in Spalte A eine ID von Mitarbeitern und es folgen 365 / 366 Spalten für jeweils 1 Tag. Es werden also nur die Daten bis einschl. 11. September abgerufen.
Ich habe herausgegoogelt, dass man die Spalten der Quelltabelle mit "F" für Field also so [F1] bis [F200] abrufen kann, wenn im ConnectionString der Wert für die Header auf No steht (HDR=NO).
Mit ein wenig Fleißarbeit kann ich die Abfrage nun auf beide Halbjahre splitten und tippe mir einen Wolf, um die Felder für die Abfrage von Hand zu tippen. Das muss doch einfacher gehen!
Meine drei Fragen:
1.) gibt es die Möglichkeit die Abfrage anders zu formulieren?
Statt query = "Select [F1], [F2], [F3] ... [F200] from [Dienst$]"
irgendwie so query = "Select von F1 bis F200 from [Dienst$]"
2.) Da der Tabellenkopf im Sheet("Dienst") Datumswerte enthält, wäre es noch eleganter / hilfreicher mittels
query = "Select [vonDatum] [bisDatum] from [Dienst$]" abfragen zu können. Ist das möglich?
3.) Lässt sich all dies auch mit "HDR=YES" im ConnectionString irgendwie bewerkstelligen?
Vielen Dank schon einmal!
mein Sub:

Sub copyData_from_Database()
str_Backend_Path = shStart.Range("Backend_Path").Value
'Connection erstellen
Dim Dienst_Conn As ADODB.Connection
'Recordset erstellen, darin werden die Daten im Speicher gehalten
Dim Dienst_Data As ADODB.Recordset
'New Instances erstellen
Set Dienst_Conn = New ADODB.Connection
Set Dienst_Data = New ADODB.Recordset
'Connection String -> Constanten & Quellangaben ganz oben
'Dienst_Conn.ConnectionString = ConStr_XLSM
Dienst_Conn.ConnectionString = "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" &  _
str_Backend_Path & ";Extended Properties=""Excel 12.0 Macro;HDR=NO"";"
'Connection ÖFFNEN
Dienst_Conn.Open
'Ziel leeren
Dim Zeilenanzahl, Spaltenanzahl As Integer
Zeilenanzahl = shWrite.Cells(Rows.Count, 1).End(xlUp).Row
Spaltenanzahl = shWrite.Cells(1, Columns.Count).End(xlToLeft).Column
With shWrite
.Activate
.Range(Cells(2, 1), Cells(Zeilenanzahl, Spaltenanzahl)).Cells.ClearContents
End With
Dim query As String
'query = "Select * from [Dienst$]"    'ruft nur bis 11.09. ab
' Spalten = [F*] -> hier ID & 1. Januar bis 30. Juni
query = "Select [F1], [F2], [F3], [F4], [F5], [F6], [F7], [F8], [F9], [F10], [F11], [F12], [F13] _
, [F14], [F15], [F16], [F17],
[F18], [F19], [F20], [F21], [F22], [F23], [F24], [F25], [F26], [F27], [F28], [F29], [F30], [ _
F31], [F32], [F33], [F34],
[F35], [F36], [F37], [F38], [F39], [F40], [F41], [F42], [F43], [F44], [F45], [F46], [F47], [F48] _
, [F49], [F50], [F51],
[F52], [F53], [F54], [F55], [F56], [F57], [F58], [F59], [F60], [F61], [F62], [F63], [F64], [F65] _
, [F66], [F67], [F68],
[F69], [F70], [F71], [F72], [F73], [F74], [F75], [F76], [F77], [F78], [F79], [F80], [F81], [F82] _
, [F83], [F84], [F85],
[F86], [F87], [F88], [F89], [F90], [F91], [F92], [F93], [F94], [F95], [F96], [F97], [F98], [F99] _
, [F100]," & _
'"[F101], [F102], [F103], [F104], [F105], [F106], [F107], [F108], [F109], [F110], [F111], [F112] _
, [F113], [F114],
[F115], [F116], [F117], [F118], [F119], [F120], [F121], [F122], [F123], [F124], [F125], [F126],  _
[F127], [F128], [F129],
[F130], [F131], [F132], [F133], [F134], [F135], [F136], [F137], [F138], [F139], [F140], [F141], _
[F142], [F143],
[F144], [F145], [F146], [F147], [F148], [F149], [F150], [F151], [F152], [F153], [F154], [F155],  _
[F156], [F157],
[F158], [F159], [F160], [F161], [F162], [F163], [F164], [F165], [F166], [F167], [F168], [F169],  _
[F170], [F171],
[F172], [F173], [F174], [F175], [F176], [F177], [F178], [F179], [F180], [F181], [F182] from [ _
Dienst$]"
' Query in recordset
Dienst_Data.Open query, Dienst_Conn
' Write header
'    Dim i As Long
'    For i = 0 To Dienst_Data.Fields.Count - 1
'        shWrite.Cells(1, i + 1).Value2 = Dienst_Data.Fields(i).Name
'    Next i
' Write data
shWrite.Range("A2").CopyFromRecordset Dienst_Data
'Recordset schließen
Dienst_Data.Close
'Connection schließen
Dienst_Conn.Close
End Sub

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Sub Zugriff_auf_Excel_Arbeitsmappe_SQL() Dim con As ADODB.Connection Dim datei As String Dim dauer As Single Dim fld As ADODB.Field Dim i As Long Dim rs As ADODB.Recordset Dim spalte As Long Dim sql As String Dim ws As Worksheet dauer = Timer Set ws = ThisWorkbook.Worksheets("Ergebnis") ws.UsedRange.ClearContents datei = ThisWorkbook.Path & "\Dienstzeiten.xlsx" ' Abfrage 1 sql = "SELECT * FROM [Dienst$A:IU]" Set con = New ADODB.Connection con.Open ConnectionString:= _ "Provider=Microsoft.ACE.OLEDB.12.0;" & _ "Data Source=" & datei & ";" & _ "Extended Properties=""Excel 12.0 Macro;HDR=Yes"";" Set rs = New ADODB.Recordset rs.Open Source:=sql, _ ActiveConnection:=con, _ CursorType:=adOpenForwardOnly, _ LockType:=adLockReadOnly, _ Options:=adCmdText ' Überschriften schreiben spalte = 1 For Each fld In rs.Fields ws.Cells(1, spalte) = fld.Name spalte = spalte + 1 Next fld ' Daten des Recordsets übernehmen ws.Range("A2").CopyFromRecordset Data:=rs, _ MaxRows:=ws.Rows.Count, _ MaxColumns:=ws.Columns.Count ' Abfrage 2 sql = "SELECT * FROM [Dienst$IV:NC]" Set con = New ADODB.Connection con.Open ConnectionString:= _ "Provider=Microsoft.ACE.OLEDB.12.0;" & _ "Data Source=" & datei & ";" & _ "Extended Properties=""Excel 12.0 Macro;HDR=Yes"";" Set rs = New ADODB.Recordset rs.Open Source:=sql, _ ActiveConnection:=con, _ CursorType:=adOpenForwardOnly, _ LockType:=adLockReadOnly, _ Options:=adCmdText ' Überschriften schreiben spalte = 256 For Each fld In rs.Fields ws.Cells(1, spalte) = fld.Name spalte = spalte + 1 Next fld ' Daten des Recordsets übernehmen ws.Range("IV2").CopyFromRecordset Data:=rs, _ MaxRows:=ws.Rows.Count, _ MaxColumns:=ws.Columns.Count ' Abschluß ws.UsedRange.Columns.AutoFit rs.Close Set rs = Nothing con.Close Set con = Nothing dauer = Timer - dauer Application.StatusBar = "Dauer: " & Format$(dauer, "0.00 \S\e\k\.") End Sub

Sub Zugriff_auf_Excel_Arbeitsmappe_SQL() Dim con As ADODB.Connection Dim datei As String Dim dauer As Single Dim fld As ADODB.Field Dim i As Long Dim rs As ADODB.Recordset Dim spalte As Long Dim sql As String Dim ws As Worksheet dauer = Timer Set ws = ThisWorkbook.Worksheets("Ergebnis") ws.UsedRange.ClearContents datei = ThisWorkbook.Path & "\Dienstzeiten.xlsx" ' Abfrage 1 sql = "SELECT * FROM [Dienst$A:IU]" Set con = New ADODB.Connection con.Open ConnectionString:= _ "Provider=Microsoft.ACE.OLEDB.12.0;" & _ "Data Source=" & datei & ";" & _ "Extended Properties=""Excel 12.0 Macro;HDR=Yes"";" Set rs = New ADODB.Recordset rs.Open Source:=sql, _ ActiveConnection:=con, _ CursorType:=adOpenForwardOnly, _ LockType:=adLockReadOnly, _ Options:=adCmdText ' Überschriften schreiben spalte = 1 For Each fld In rs.Fields ws.Cells(1, spalte) = fld.Name spalte = spalte + 1 Next fld ' Daten des Recordsets übernehmen ws.Range("A2").CopyFromRecordset Data:=rs, _ MaxRows:=ws.Rows.Count, _ MaxColumns:=ws.Columns.Count rs.Close ' Abfrage 2 sql = "SELECT * FROM [Dienst$IV:NC]" rs.Open Source:=sql, _ ActiveConnection:=con, _ CursorType:=adOpenForwardOnly, _ LockType:=adLockReadOnly, _ Options:=adCmdText ' Überschriften schreiben spalte = 256 For Each fld In rs.Fields ws.Cells(1, spalte) = fld.Name spalte = spalte + 1 Next fld ' Daten des Recordsets übernehmen ws.Range("IV2").CopyFromRecordset Data:=rs, _ MaxRows:=ws.Rows.Count, _ MaxColumns:=ws.Columns.Count ' Abschluß ws.UsedRange.Columns.AutoFit rs.Close Set rs = Nothing con.Close Set con = Nothing dauer = Timer - dauer Application.StatusBar = "Dauer: " & Format$(dauer, "0.00 \S\e\k\.") End Sub

Hallo Chris & Dieter,
vielen Dank für eure Antworten und die Mühe mit der Beantwortung.
@ Chris:
PowerQuery kommt leider nicht in Frage, da im Userinterface später sämtliche Excel Bedienelemente & Schaltflächen ausgeblendet werden. Es soll alles über cmdButtons und VBA Code laufen. Das spart Platz auf dem Bildschirm und verhindert hoffentlich, dass mir jemand die Datei zerschießt.
@ Dieter:
Ich ziehe mal wieder meinen Hut vor euch Excel-Profis. Danke, dass Du nicht einfach nur meine Fragen beantwortet hast, sondern gleich lauffähigen Code und Beispielmappen mitgesendet hast. Der Wahnsinn, vielen Dank!
Eine kleine letzte Frage bleibt mir noch:
die Schleife
spalte = 1
For Each fld In rs.Fields
ws.Cells(1, spalte) = fld.Name
spalte = spalte + 1
Next fld
schreibt die Spaltenköpfe aus dem rs in das Zielblatt. Da es sich dabei um Datumswerte handelt, werden die Überschriften so dargestellt: 01#01#2021 (Zellformat Standart)
Wie bekomme ich es hin, dass er die Datumswerte als Datum übernimmt bzw. ist es möglich, das im deutschen Datumsformat 01.01.2021 schreibt?
Nochmals vielen Dank und einen schönen Abend!
Gruß, Berni.

For Each fld In rs.Fields überschrift = Replace(fld.Name, "#", ".") If IsNumeric(überschrift) Then überschrift = CDate(überschrift) End If ws.Cells(1, spalte) = überschrift spalte = spalte + 1 Next fld

Beliebteste Forumthreads (12 Monate)

ADODB Abfrage - nur spezifische Spalten

7
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

2 Forumthreads zu ähnlichen Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

ADODB Abfrage - nur spezifische Spalten

7 Beiträge zum Forumthread Beiträge zu diesem Forumthread

2 Forumthreads zu ähnlichen Themen

VBA Beispiele zu verwandten Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

7
Beiträge zum Forumthread

Beiträge zu diesem Forumthread