PDA

Vollständige Version anzeigen : Daten aus geschlossener Datei


HolN
31.03.2012, 04:45
Hallo zusammen,

zur Zeit habe ich ein VBA Code der mir eine zweite XLS Datei öffnet und in der aus einer Spalte die letzte Zeile ermittelt sowie die einzelnen Werte der Spalte in ein Array übernimmt. Danach wird die Datei wieder geschlossen und die Daten werden weiter verarbeitet.

Gibt es eine Möglichkeit, an den Daten zu kommen ohne die Datei zu öffnen. Ich erhoffe mir dadurch eine Geschwindigkeitsverbesserung.

Danke für Tipps
nolle

Hajo_Zi
31.03.2012, 08:05
Option Explicit

Public Function GetDataClosedWB(SourcePath As String, _
SourceFile As String, sourceSheet As String, _
SourceRange As String, TargetRange As Range) As Boolean
'Holt einen Bereich aus einer _geschlossenen_ Arbeitsmappe
'Nur in VBA zu verwenden; nicht aus einer Tabellenzelle heraus
'© t.ramel@mvps.org
' wird durch die HoleDaten aufgerufen
Dim strQuelle As String
Dim Zeilen As Long
Dim Spalten As Byte
On Error GoTo InvalidInput
strQuelle = "'" & SourcePath & "[" & SourceFile & "]" & sourceSheet & "'!" & Range(SourceRange).Cells(1, 1).Address(0, 0)
Zeilen = Range(SourceRange).Rows.Count
Spalten = Range(SourceRange).Columns.Count
With TargetRange.Cells(1, 1).Resize(Zeilen, Spalten)
.Formula = "=IF(" & strQuelle & "="""",""""," & strQuelle & ")"
.Value = .Value
End With
GetDataClosedWB = True
Exit Function
InvalidInput:
MsgBox "Die Quelldatei oder der Quellbereich ist ungültig!", vbExclamation, "Get data from closed Workbook"
GetDataClosedWB = False
End Function

Public Sub HoleDaten()
' Die Funktion arbeitet mit der obrigen GetDataClosedWB zusammen
Dim Pfad As String
Dim Dateiname As String
Dim Blatt As String
Dim Bereich As String
Dim Ziel As Range
Pfad = "L:\Eigene Dateien\Hajo\Internet\Test\2009\"
Dateiname = "Beispiel Forum 30.xlsm" ' aus welcher Datei soll er holen?
Blatt = "Tabelle1" ' von welcher Tabelle soll er holen?
Bereich = "A1:B9" ' aus welchem Bereich soll er holen?
Set Ziel = ActiveSheet.Range("A1") ' in welchen Bereich soll er kopieren? Genauer gesagt: Bei welcher Zelle soll er anfangen, Datein reinzukopieren? Bsp: ActiveCell geht auch
If GetDataClosedWB(Pfad, Dateiname, Blatt, Bereich, Ziel) Then
MsgBox "Daten importiert"
End If
End Sub


<img src="http://Hajo-Excel.de/images/grusz1.gif" align="middle" height="40" alt="Grußformel"><a href="http://Hajo-Excel.de/index.htm" onclick="window.open(this.href);return false"><img border="0" src="http://Hajo-Excel.de/images/logo_hajo3.gif" align="middle" height="40" alt="Homepage"></a>

Thomas Ramel
31.03.2012, 08:36
Grüezi Nolle

Wenn du weisst welcher Bereich die Daten enthält kannst Du diese mimt meinem Code, den Hajo gezeigt hat direkt auslesen (lassen).

Aber es ist in einer geschlossenen Mappe nicht möglich Bereiche zu prüfen oder Inhalte zu zählen.

HolN
31.03.2012, 09:08
Hallo Hajo, Hallo Thomas

Hajo danke für den Code, Thomas danke für die Erklärung.

Eigentlich müsste ich die Daten in der geschlossenen Mappe zählen um meinen Bereich zu definieren. Wenn das aber nicht geht, könnte ich auch einen Bereich nehmen in dem ich mir sicher bin das alle Daten erfasst sind.
Meine Vorstellung wäre jetzt ein dreidimensionales Array in dem die Daten von (A100:B100;F100) enthalten sind.

Würde das gehen und kann mir einer den Code dafür nennen.

Danke + Gruß
nolle

josef e
31.03.2012, 16:27
<div style="width:85%; margin-left:5px; margin-right:15px; text-align:justify;">
Hallo Nolle,

ob das geht, hängt einzig und alleine vom Aufbau der Tabelle ab.

Lade ein Beispiel hoch und beschreibe, was du genau auslesen willst.


</div>

<div style="width:100px; text-align:center; color:white; font-style:italic; font-size:0.8em; font-family:Tahoma; background-color:royalblue;margin-left:5px; margin-top:15px; padding:4px; border:3px double darkblue;">&laquo; Gru&szlig; Sepp &raquo;</div>

HolN
31.03.2012, 16:43
Hallo Sepp,

ich mochte gerne die Daten aus A1:A100 B1:B100 sowie F1:F100 auslesen ohne die Datei zu öffnen.
Die Werte sollen mir in ein Array(100,3) geschrieben werden mit denen ich dann weiter arbeite.

Gruß
nolle

Thomas Ramel
31.03.2012, 17:05
Grüezi Nolle

Müssen die Daten in ein Array im Speicher geschrieben werden oder reichen da drei Spalten in einem (ev. temporären) Tabellenblatt auch aus?

Dann nimm den Code oben in zwei Durchgängen über deine beiden zusammenhängenden Bereiche und lasse diese in drei nebeneinander liegende Spalten schreiben.

Diesen Bereich kannst Du dann in dein Array einlesen und das Tabellenblatt (wenn es temporär war) dann wieder löschen.

Brauchst Du dafür neben den Erläuterungen im Code noch weitere Unterstützung?

HolN
31.03.2012, 17:48
Hallo Thomas,

in einem Array wäre natürlich besser. Aber wenns nicht geht muß ich eben den Umweg mit deinem Vorschlag machen.
Wenn ich den o.g. Code übernehme kommt immer eine Meldung das ich die Daten aktulisieren soll. Dann muß ich die Quelldatei nochmals auswählen

Gruß
nolle

Thomas Ramel
31.03.2012, 18:30
Grüezi Nolle

Dann passt irgendwas mit den Pfacen und/oder Dateinamen die Du der Sub übergibst nicht. Ein Leerzeichen oder ein Slash - irgendwas ist da nicht vorhanden, sonst meldet sich Excel nicht.

Prüfe dies daher nochmal ganz penibel.

Ich habe dem Code zwischenzeitlich noch eine Prüfung eingebaut ob der Pfad auch wirlich einen Slash am Ende aufweist und dies korrigiert wenn das nicht der Falle ist:


Public Function GetDataClosedWB(SourcePath As String, _
SourceFile As String, _
SourceSheet As String, _
SourceRange As String, _
TargetRange As Range, _
Optional blFormula As Boolean) As Boolean

'Holt einen Bereich aus einer _geschlossenen_ Arbeitsmappe
'Nur in VBA zu verwenden; nicht aus einer Tabellenzelle heraus
'© t.ramel@mvps.org

Dim strQuelle As String
Dim Zeilen As Long
Dim Spalten As Byte

On Error GoTo InvalidInput

If Right(SourcePath, 1) <> "\" Then SourcePath = SourcePath & "\"

strQuelle = "'" & SourcePath & "[" & SourceFile & "]" & _
SourceSheet & "'!" & _
Range(SourceRange).Cells(1, 1).Address(0, 0)

Zeilen = Range(SourceRange).Rows.Count
Spalten = Range(SourceRange).Columns.Count

With TargetRange.Cells(1, 1).Resize(Zeilen, Spalten)
.Formula = "=IF(" & strQuelle & "="""",""""," & strQuelle & ")"
If Not blFormula Then .Value = .Value
End With

GetDataClosedWB = True
Exit Function

InvalidInput:
MsgBox "Die Quelldatei oder der Quellbereich ist ungültig!", _
vbExclamation, "Get data from closed Workbook"
GetDataClosedWB = False
End Function

HolN
01.04.2012, 06:37
Hallo Thomas,
hatte ein \ am Ende vergessen. Kann meine Daten jetzt aus der geschlossenen Datei lesen.

Danke + Gruß
nolle

Thomas Ramel
01.04.2012, 10:12
Grüezi Nolle

Ja, meistens liegt das an Kleinigkeiten - mit dem angepassten Code wird dieses Manko korrigiert.


Wie sieht es denn im Vergleicht mit der Geschwindigkeit aus?
Kannst Du die Daten auf diese Weise schneller aus der Mappe holen?

HolN
01.04.2012, 13:05
Hallo Thomas,
von der Geschwindigkeit habe ich mir mehr versprochen. Ich merke keinen Unterschied als wenn ich die Mappe per Makro öffne und mir dann die Daten daraus ziehe. Es sind ja nicht viele Daten. 300 Zellen. Das alles passiert jetzt hier bei mir lokal auf meinem privaten Recher. Mal sehen wie der Vergleich morgen iim Büro ausfällt. Dort liegen die Daten auf einen Netzlaufwerk. Ich weiss auch noch nicht was passiert wenn die Mappe von einer anderen Person geöffnet ist.

Gruß
nolle

Thomas Ramel
01.04.2012, 13:20
Grüezi Nolle

Ja, das hatte ich eigentlich auch nicht anders erwartet - in aller Regel geht es sogar schneller wenn die verknüpfte Mappe geöffnet wird, da das Importieren mit einer Formel eben auch Zeit benötigt und zumindest ein DDE-Kanal zur Mappe hergestellt werden muss.

josef e
01.04.2012, 13:22
<div style="width:85%; margin-left:5px; margin-right:15px; text-align:justify;">
Hallo Nolle,

darauf http://ms-office-forum.net/forum/showpost.php?p=1440266&postcount=5 hast du ja nicht entsprechend reagiert!


</div>

<div style="width:100px; text-align:center; color:white; font-style:italic; font-size:0.8em; font-family:Tahoma; background-color:royalblue;margin-left:5px; margin-top:15px; padding:4px; border:3px double darkblue;">&laquo; Gru&szlig; Sepp &raquo;</div>

HolN
01.04.2012, 13:41
Hallo Sepp,

ich hatte ja geschrieben das es eine ganz einfache Tabelle ist von der ich mir die Bereiche A1:B100;F1:F100) rausziehen wollte.

Dachte mir das ich hier nicht unbedingt notwendig ist eine Beispielmappe hochzuladen.

Gruß
nolle

josef e
01.04.2012, 13:48
<div style="width:85%; margin-left:5px; margin-right:15px; text-align:justify;">
Hallo Nolle,

OK, ich hab ja das Problem nicht.

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


</div>

<div style="width:100px; text-align:center; color:white; font-style:italic; font-size:0.8em; font-family:Tahoma; background-color:royalblue;margin-left:5px; margin-top:15px; padding:4px; border:3px double darkblue;">&laquo; Gru&szlig; Sepp &raquo;</div>

HolN
21.09.2017, 12:12
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

R J
21.09.2017, 12:49
...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

Luschi
21.09.2017, 15:45
Hallo Ralf,

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

Gruß von Luschi
aus klein-Paris

R J
21.09.2017, 15:54
zeigst Du bitte noch, was in der Prozedur 'Protokoll' steht?

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....:)

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

Public Sub Protokoll(msg As String)
Worksheets("Protokoll").Cells(lastProtokollzeile, 1) = msg
lastProtokollzeile = lastProtokollzeile + 1
End Sub

...aber die lastProtokollzeile dürft Ihr selbst Public(en)....;)

Luschi
21.09.2017, 15:59
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

R J
21.09.2017, 16:18
@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....;)
Hatte oben noch nachträglich die Prozedur angehängt.

HolN
22.09.2017, 05:56
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