Office: Daten aus geschlossener Datei

Hallo Nolle,

OK, ich hab ja das Problem nicht.

Was hast du daran "ob das geht, hängt einzig und alleine vom Aufbau der Tabelle ab" nicht verstanden?




« Gruß Sepp »

 

Hallo,

wie kann ich den Code so ändern, das beim Lesen der geschlossenen Mappe nicht gefragt wird ob werte aktualisiert werden sollen.

In der Datei stehen formeln mit bezug auf einer anderen Tabelle

Schreibe ich am Anfang des codes

displayallerts = false

dann werde ich zwar nicht mehr gefragt, aber als ergebnis bekomme ich nur #Bezug

Gruß
nolle

 

...anbei mal ein Bsp, wie man Daten via ADO ausliest. Das musst Du halt an Deine Bedürfnisse anpassen....

Option Explicit

'Es muss die
'Microsoft ActiveX Data Objects x.x Library
'in das Projekt eingebunden werden.

'Tabellenblattname
'Für den Zugriff auf die Excel-Tabelle mittels ADO muss der Tabellenblattname mit dem $-Zeichen ergänzt werden und
'auch in eckigen Klammern ([ ]) gesetzt werden.
'
' [Tabellenname$]
' [Tabellenname$A1:C5]
' [Tabellenname$A2:A2]
'
'
'Quellbereich
'Wird als Quellbereich ein Bereich angegeben, das keine Daten enthält, so werden unter Umständen trotzdem Datensätze
'zurückgegeben. Dies ist z. B. dann der Fall, wenn im Quellbereich irgendwann Daten enthalten waren, diese jedoch
'lediglich mit der Taste Entf gelöscht wurden, und nicht die Zeile selbst (Zellen löschen... /Ganze Zeile).
'Spaltenüberschriften
'Wird als Quellbereich nur eine Zeile oder eine einzelne Zelle angegeben, muss beim Aufruf der folgenden Funktion für
'das Argument fColHDR (ColumnHeader) False übergeben werden!
'
'Funktion zum Auslesen der Daten (ADO)
'
'Der Prozedur zum Auslesen der Daten aus der geschlossenen Arbeitmappe wird
' - der Dateiname der geschlossenen Arbeitsmappe inkl. Pfad
' - der SQL-String, in dem der Quellbereich angegeben ist und ggf. weitere Kriterien/Bedingungen
' - ob Spaltenüberschriften vorhanden sind
' - und ein Datenfeld für die Daten aus dem Quellbereich
'übergeben.
'Hier wird die GetRows-Methode verwendet, um die Datensätze aus dem Recordset in ein zweidimensionales Datenfeld zu
'kopieren. Damit die Daten in das Ziel-Tabellenblatt eingefügt werden können, müssen die Daten im Datenfeld
'anschließend transponiert.
'Wenn bei der Ausführung der Funktion keine Fehler aufgetreten sind, ist der Rückgabewert der Funktion True,
'und im Datenfeld avarDataXL() sind die entsprechenden Daten aus dem Quellbereich enthalten.

Public arrEditFelder() As Variant

Public Sub Hole_Daten_via_ADO(QuellPfadUndDatei As String, quelltabelle As String, Optional editiere As Boolean)
Dim strDBName As String
Dim strSource As String
Dim strSQL As String
Dim avarDataXL() As Variant

Dim optXLCalcMode As Long

Dim wksDest As Worksheet
Dim nColDest As Integer
Dim nRowDest As Long
Application.StatusBar = "Lese Daten aus: " & QuellPfadUndDatei

'Schreibschutz entfernen
'Debug.Print "Lese Daten aus: " & QuellPfadUndDatei
VBA.FileSystem.SetAttr QuellPfadUndDatei, vbNormal

strDBName = QuellPfadUndDatei
strSource = "[" & quelltabelle & "$]"
strSQL = "SELECT * FROM " & strSource & ";"

Erase arrEditFelder

If Len(Dir$(strDBName)) = 0 Then
Protokoll "Die Datei " & strDBName & " existiert nicht!"
'Debug.Print strDBName
Exit Sub
End If

If GetDataFromWkb_ADO(strDBName, strSQL, True, avarDataXL()) Then
With Application
optXLCalcMode = .Calculation
.Calculation = xlManual
.EnableEvents = False
End With

nColDest = 1
Set wksDest = Arbeitsdatei.Worksheets("Daten" & auswertungsjahr)
On Error Resume Next
With wksDest
If Not editiere Then
If Application.WorksheetFunction.CountA(.Cells) > 0 Then
nRowDest = .Cells.Find(what:="*", After:=.Cells(1, 1), _
SearchOrder:=xlByRows, _
SearchDirection:=xlPrevious).Row + 1
Else
nRowDest = 2
End If

Err.Clear
arrEditFelder = avarDataXL
' .Cells(nRowDest, 1).Activate
.Cells(nRowDest, nColDest).Resize( _
UBound(avarDataXL, 1) + 1, _
UBound(avarDataXL, 2) + 1).Value = avarDataXL
'
If Err.Number = 0 Then
.UsedRange.Columns.AutoFit
' Else
' arrEditFelder = avarDataXL

' MsgBox "Die Daten aus dem Quellbereich '" & strSource & _
' "' wurden eingelesen!", vbInformation, "Alles paletti"

Else
Protokoll "Fehler " & Err.Number & " " & Err.Description & " Fehler beim Einlesen der Datei " & QuellPfadUndDatei
End If
Else
'editierte Dateien
arrEditFelder = avarDataXL
End If

' Dim x&
' For x = .Cells.SpecialCells(xlCellTypeLastCell).Row To .Cells.SpecialCells(xlCellTypeLastCell).Row - UBound(avarDataXL, 1)
' if
' Next x
End With

Erase avarDataXL
Set wksDest = Nothing

With Application
.EnableEvents = True
.Calculation = optXLCalcMode
End With
End If
On Error GoTo 0
End Sub

Private Function GetDataFromWkb_ADO(ByVal strDBName As String, _
ByVal strSQL As String, ByVal fColHDR As Boolean, _
ByRef avarDataXL() As Variant) As Boolean

Dim cnnADO As ADODB.Connection
Dim rstADO As ADODB.Recordset
Dim strExtProps As String
Dim avarDataRS As Variant

Dim nFieldsCnt As Long
Dim nRecordsCnt As Long
Dim arrLiesZeilen() As Long

Dim nFld As Long
Dim nRec As Long

Dim blnData As Boolean

Dim sAdoConnectString$

strExtProps = "Excel 8.0;"
If Not fColHDR Then
strExtProps = strExtProps & "HDR=No;"
End If

On Error GoTo err_GetValues

'Dim OfficeVersion As Byte
'
'Select Case Val(Application.Version)
' Case 8
' OfficeVersion = 8 ' & vbCrLf & "Excel 97"
' Case 9
' OfficeVersion = 9 '& vbCrLf & "Excel 2000"
' Case 10
' OfficeVersion = 10 '& vbCrLf & "Excel 2002/XP"
' Case 11
' OfficeVersion = 11 '& vbCrLf & "Excel 2003"
' Case 12
' OfficeVersion = 12 '& vbCrLf & "Excel 2007"
' Case Else
' OfficeVersion = 0
' Exit Sub
'End Select


' Dim oAdoConnection As New ADODB.Connection
' Dim oAdoRecordset As New ADODB.Recordset
' Dim sAdoConnectString As String, sPfad As String
' Dim sQuery As String
' On Error GoTo Fehler
' sPfad = ThisWorkbook.FullName
' sAdoConnectString = _
' "DRIVER={Microsoft Excel Driver (*.xls)};ReadOnly=1;DBQ=" & sPfad
' oAdoConnection.Open sAdoConnectString



Set cnnADO = New ADODB.Connection
With cnnADO
If Application.Version >= 12 Then
sAdoConnectString = "Provider=Microsoft.ACE.OLEDB.12.0; Extended Properties='Excel 12.0 Xml;HDR=YES';Data Source=" & strDBName


' .Provider = "Microsoft.ACE.OLEDB.12.0"
' .Data Source = strDBName
' .Properties = "Excel 12.0 Xml;HDR=YES"
ElseIf Application.Version 0 Then
sAdoConnectString = "DRIVER={Microsoft Excel Driver (*.xls)};ReadOnly=1;DBQ=" & strDBName

' .Provider = "Microsoft.Jet.OLEDB.4.0"
' .Data Source = strDBName
' .Properties("Extended Properties").Value = strExtProps
Else
Protokoll "Unbekannte Version von Excel"
Exit Function
End If
' .Open strDBName
.Open sAdoConnectString
End With

Set rstADO = New ADODB.Recordset
With rstADO
.ActiveConnection = cnnADO
.CursorLocation = adUseClient
.Source = strSQL
.Open
End With

If Not (rstADO.EOF Or rstADO.BOF) Then
avarDataRS = rstADO.GetRows()
If IsArray(avarDataRS) Then
nFieldsCnt = UBound(avarDataRS, 1)
nRecordsCnt = UBound(avarDataRS, 2)

Dim spalte%, zeile As Long, neueZ As Long
For zeile = 0 To nRecordsCnt
For spalte = 0 To nFieldsCnt
If Not IsNull(avarDataRS(spalte, zeile)) Then
' Debug.Print avarDataRS(spalte, zeile)
ReDim Preserve arrLiesZeilen(neueZ)
arrLiesZeilen(neueZ) = zeile
neueZ = neueZ + 1
Exit For
End If
Next spalte
Next zeile




ReDim avarDataXL(neueZ, nFieldsCnt)

For nFld = 0 To nFieldsCnt 'Spalten
For nRec = 0 To UBound(arrLiesZeilen()) 'Zeilen

If Not IsNull(avarDataRS(nFld, arrLiesZeilen(nRec))) Then
' If IsDate(avarDataRS(nFld, nRec)) Then
' avarDataXL(nRec, nFld) = _
' Format$(avarDataRS(nFld, nRec), "yyyy-mm-dd")
' Else
avarDataXL(nRec, nFld) = avarDataRS(nFld, arrLiesZeilen(nRec))
' Debug.Print avarDataXL(nRec, nFld)
' End If
blnData = True
End If
Next
Next
Erase avarDataRS

If blnData Then
GetDataFromWkb_ADO = True
Else
Protokoll "Der Quellbereich enthält keine Daten! " & strDBName & " ( " & strSQL & ")"
End If
End If
Else
Protokoll "Keine Datensätze in " & strDBName & " gefunden!"
End If

exit_Func:
On Error Resume Next

rstADO.Close
Set rstADO = Nothing
cnnADO.Close
Set cnnADO = Nothing

On Error GoTo 0
Exit Function

err_GetValues:
'Debug.Print Err.Description & " " & strDBName
Protokoll "Fehler " & Err.Number & vbCrLf & Err.Description & " in " & strDBName
Resume exit_Func
End Function

Function liesZeile(zeile As Long, anzZeilen As Long, Spalten As Long, avarDataRS As Variant) As Variant()
Dim nFld As Long
ReDim avarDataXL(anzZeilen, Spalten)
For nFld = 0 To Spalten 'Spalten

If Not IsNull(avarDataRS(nFld, zeile)) Then
avarDataXL(anzZeilen, Spalten) = avarDataRS(nFld, zeile)
End If
Next
liesZeile = avarDataXL
End Function

 

Hallo Ralf,

zeigst Du bitte noch, was in der Prozedur 'Protokoll' steht?

Gruß von Luschi
aus klein-Paris

 

Im Grunde kann man den Aufruf der Prozedur auskommentieren, da sie, wie der Name schon sagt, dafür zuständig ist, ein (Fehler)protokoll zu erstellen. Wenn ich mich recht entsinne (ist ja schon ein paar Jährchen her, als ich das programmierte), bezog sich das aber schon sehr spezifisch auf die vorhandene Umgebung. Kann aber, falls wirklich erforderlich, das gern noch mal raussuchen und anhängen. Aber wie gesagt, hat nichts mit der gewünschten Funktionalität (auslesen von Daten aus geschlossenen Dateien) zu tun.
Könnte sogar sein, das innerhalb der Prozedur Protokoll dann auch wieder andere Prozeduren aufgerufen werden. Das wäre dann ein Rattenschwanz ohne Ende....*Smilie

Edit:
Ha, war gar nicht schlimm. Da steht nicht viel drin. Also hier die Prozedur:
Code:

...aber die lastProtokollzeile dürft Ihr selbst Public(en)....*wink.gif*

 

Hallo Ralf,

danke für die ausführliche Erklärung, hatte mir schon sowas gedacht und werde die Routine mit einer Msgbox selbst erstellen.

Gruß von Luschi
aus klein-Paris

 

\@Luschi,

MsgBox ist, denke ich, keine so gute Idee. Da Du ja auf "leere" Bereiche treffen kannst, wo also die Zeilen nicht ordnungsgenäß gelöscht wurden, im schlimmsten Fall zum Dauerklicker mutierst....*wink.gif*
Hatte oben noch nachträglich die Prozedur angehängt.

 

Hallo Ralf,

den Code verstehe ich nicht. Bin wohl schon zu alt dafür.

Der Code von Thomas Ramel habe ich begriffen. Kann man den nicht so ändern, das nur Werte ausgelesen werden und keine Formeln. Damit als Ergebnis nicht #Bezug rauskommt.

gruß
nolle