Excel OHNE öffnen bearbeiten
04.12.2018 14:13:58
Aleks
ich habe eine Frage an euch Profis :)
Ich habe eine "Master-Datei", welche aus verschiedenen Dateien die wichtigsten Zahlen raussucht. Diese Zahlen werden am Anfang in einem Cockpit dargestellt. In diesem Cockpit habe ich ein Feld in dem ich nur einen Stichtag eingeben und es filtert mir quasi die Informationen zum gewünschten Stichtag raus.
Jetzt habe ich ein neues "produkt" mit dem ich quasi aus diesen verschiedenen "Master-Dateien" das cockpit automatisch rausfiltern kann ohne alle Dateien immer zu öffnen. Jetzt möchte ich es NOCH einfacher.
Wie kann ich ohne die "Master-Dateien" zu öffnen, das Datum ändern aus meinen 5 gleich aufgebauten "Master-Dateien" verändern? Das Feld Datum ist in allen Dateien an der gleichen stelle.
Ich möchte also in meinem "Produkt" das ohnehin schon das Cockpit der 5 verschiedenen "Master-Dateien" rausfiltert also ein Feld in dem ich das Datum verändern kann (aus den geschlossenen Dateien um dann das Cockpit zu einem gewissen Stichtag rauszufiltern)
So siehts aus bisher:
Function GetConnXLS(ByVal cFileName As String, _
Optional ByVal InformErrMSG As Boolean = False) As ADODB.Connection
'EDIT by Aleksandar Jakovljevic
'On Error GoTo LOI:
'Open ADO connection to excel workbook
Dim oConn As ADODB.Connection
Dim Ext As String, ConnStr As String
Set oConn = New ADODB.Connection
ConnStr = "Provider=Microsoft.ACE.OLEDB.12.0;" & _
"Data Source=" & cFileName & ";" & _
"Extended Properties=""Excel 12.0 xml;HDR=Yes"";"
oConn.Open ConnStr
Set GetConnXLS = oConn
Exit Function
LOI:
If Err.Number 0 Then
Set oConn = Nothing
If InformErrMSG Then
MsgBox "GetConnXLS" & ": " & Err.Number & " " & Err.Description, vbCritical
End If
End If
End Function
Sub Merge_All()
Dim cnn As ADODB.Connection
Dim rst As ADODB.Recordset
Dim sh As Worksheet
Dim I As Long, k As Long, CountFiles As Long, J As Long, strData, _
kDS As Long, xKorr As Integer
files = Application.GetOpenFilename(, , , , True)
If VarType(files) = vbBoolean Then Exit Sub
Set sh = Sheets("Master")
For k = LBound(files) To UBound(files)
'Anzahl der Datensätze in der ausgewählten Datei ermitteln
kDS = lastRowClosedFile(files(k), "Cockpit", "A:A")
'ADODB-Connection erstellen
Set cnn = GetConnXLS(files(k))
If cnn Is Nothing Then
MsgBox "Check lai co so du lieu file: " & files(k)
Exit Sub
End If
'Select-Befehl zusammenstellen (quasi welche Daten ausgewählt werden sollen)
strData = "SELECT * From [Cockpit$A1:D10" & kDS & "];"
'Recordset öffnen auf der Grundlage der Connection & Select-Befehl
Set rst = cnn.Execute(strData)
CountFiles = CountFiles + 1
If CountFiles = 1 Then
For J = 0 To rst.Fields.Count - 1
sh.Cells(3, J + 1).Value = rst.Fields(J).Name
Next J
End If
If k = 1 Then
xKorr = 1
Else
xKorr = 0
End If
sh.Range("I" & 4 + I - xKorr).Value = files(k)
I = I + sh.Range("A" & 4 + I).CopyFromRecordset(rst)
rst.Close
Set rst = Nothing
cnn.Close
Set cnn = Nothing
Next k
MsgBox "Done", vbSystemModal + 48, "Hurraaa..."
End Sub
Anzeige