13.07.2017, 10:51
Hallo,
ich habe aktuell eine sehr aufwendige VBA Abfrage, die zu viele Dateien täglich abfragt. Jetzt ist meine Überlegung, ob man das alles so einstellen kann, dass diese nur noch den aktuellen Monat abfragt (dieser in extra Ordner) und dann nur noch Neuerungen in eine zweite Liste einfügt.
ist das möglich??
VBA für die Abfrage:
Aktuell Exportiere ich komplett:
Kann ich jetzt Quasi vor dem Schritt exportieren, einen schritt einfügen, die Tabelle "Füllung" mit der Tabelle "Komplett" zu vergleichen und die Neuerungen anzufügen??
Vielen Dank schon mal im voraus.
Gruß
ich habe aktuell eine sehr aufwendige VBA Abfrage, die zu viele Dateien täglich abfragt. Jetzt ist meine Überlegung, ob man das alles so einstellen kann, dass diese nur noch den aktuellen Monat abfragt (dieser in extra Ordner) und dann nur noch Neuerungen in eine zweite Liste einfügt.
ist das möglich??
VBA für die Abfrage:
Code:
Sub Lese()
Dim intBereich As Integer
Dim intZeile As Integer
Dim intSpalte As Integer
Dim strDatei As String
Dim intAnzVerz As Integer
Dim intAktVerz As Integer
Dim intAktBlatt As Integer
Dim intAktZeile As Integer
Dim intAktSpalte As Integer
Dim intSpDatum As Integer
Dim intSpBlatt As Integer
Dim intSpDatei As Integer
Dim intSpVerz As Integer
Dim strVerz As String
Dim strVerzA() As String
Dim varDatum As Variant
Dim varKopie As Variant
Dim varRngKopie As Variant
Dim bolLeer As Boolean
Dim rngAusgabe As Range
Dim wbLesen As Workbook
Dim wsLesen As Worksheet
Const intMaxVerz As Integer = 30
Const intMaxblatt As Integer = 2
Const strTeilDatei As String = ".xlsx"
Const strRngDatum As String = "C2"
Const strRngKopie As String = "B3:J55"
Const bolZeigVerz As Boolean = False
Const bolZeigDatei As Boolean = False
Const bolZeigBlatt As Boolean = False
Const bolZeigLeer As Boolean = True
Application.ScreenUpdating = False
'----------------------------------------------------
' Spalten für Verzeichnis, Datei und Blatt einrichten
'----------------------------------------------------
intSpDatum = 0
intSpBlatt = 0
intSpDatei = 0
intSpVerz = 0
If bolZeigBlatt Then
intSpDatum = intSpDatum + 1
End If
If bolZeigDatei Then
intSpDatum = intSpDatum + 1
intSpBlatt = intSpBlatt + 1
End If
If bolZeigVerz Then
intSpDatum = intSpDatum + 1
intSpBlatt = intSpBlatt + 1
intSpDatei = intSpDatei + 1
End If
varRngKopie = Split(strRngKopie)
'----------------------------------------------------
' Verzeichniseinlesen und Variablen initialisieren
'----------------------------------------------------
ReDim strVerzA(intMaxVerz)
intAktVerz = 1
intAnzVerz = 1
intAktZeile = 0
strVerzA(intAnzVerz) = ThisWorkbook.Names("Verzeichnis").RefersToRange
Set rngAusgabe = ThisWorkbook.Worksheets("Füllung").Cells(3, 1)
'Set rngAusgabe = ThisWorkbook.Names("Ausfüllen").RefersToRange
'----------------------------------------------------
' Schleife über Verzeichnisse
'----------------------------------------------------
While intAktVerz <= intAktVerz And intAktVerz <= intMaxVerz
strVerz = strVerzA(intAktVerz)
strDatei = Dir(strVerz, vbDirectory)
'----------------------------------------------------
' Schleife über Dateien im Verzeichnis
'----------------------------------------------------
While strDatei <> ""
If (GetAttr(strVerz & strDatei) And vbDirectory) = vbDirectory Then
If strDatei <> "." And strDatei <> ".." And strDatei <> "" And intAnzVerz < intMaxVerz Then
intAnzVerz = intAnzVerz + 1
strVerzA(intAnzVerz) = strVerz & strDatei & "\"
End If
Else
If InStr(strDatei, strTeilDatei) > 0 And strDatei <> ThisWorkbook.Name Then
intAktBlatt = 0
Set wbLesen = Workbooks.Open(Filename:=strVerz & strDatei, ReadOnly:=True)
For Each wsLesen In wbLesen.Worksheets
intAktBlatt = intAktBlatt + 1
If intAktBlatt <= intMaxblatt Then
varDatum = wsLesen.Range(strRngDatum)
For intBereich = 0 To UBound(varRngKopie)
varKopie = wsLesen.Range(varRngKopie(intBereich)).Value
For intZeile = 1 To UBound(varKopie, 1)
'----------------------------------------------------
' Prüfen ob Werte leer
'----------------------------------------------------
If bolZeigLeer Then
bolLeer = False
Else
bolLeer = True
For intSpalte = 1 To UBound(varKopie, 2)
If varKopie(intZeile, intSpalte) <> "" Then
bolLeer = False
End If
Next intSpalte
End If
'----------------------------------------------------
' Schreiben wenn nicht leer
'----------------------------------------------------
If Not bolLeer Then
For intSpalte = 1 To UBound(varKopie, 2)
rngAusgabe.Offset(intAktZeile, intSpalte + intSpDatum).Value = varKopie(intZeile, intSpalte)
Next intSpalte
rngAusgabe.Offset(intAktZeile, intSpVerz).Value = strVerz
rngAusgabe.Offset(intAktZeile, intSpDatei).Value = strDatei
rngAusgabe.Offset(intAktZeile, intSpBlatt).Value = wsLesen.Name
rngAusgabe.Offset(intAktZeile, intSpDatum).Value = varDatum
intAktZeile = intAktZeile + 1
End If
Next intZeile
Next intBereich
End If
Next wsLesen
wbLesen.Close savechanges:=False
End If
End If
strDatei = Dir()
Wend
intAktVerz = intAktVerz + 1
Wend
Application.ScreenUpdating = True
End SubAktuell Exportiere ich komplett:
Code:
Sub Tabelle_kopieren()
' Tabelle_kopieren Makro
Const strZiel As String = "R:\xxx.xlsm" 'Pfad + Dateiname
Const strZiel2 As String = "R:\xxxx.xlsm" 'Pfad + Dateiname
Const strZiel3 As String = "R:\xxxxx.xlsm" 'Pfad + Dateiname
Const strZiel4 As String = "R:\xxxxxx.xlsx" 'Pfad + Dateiname
Dim WB_B As Workbook
Dim WsQuelle As Worksheet
Dim WsZiel As Worksheet
'Quellesheet definieren
Set WsQuelle = ThisWorkbook.Sheets("Füllung") ' <= eventuell falsch angepasst? Hier muss der Name des Ausgangsblattes hin, oder?
'Ziel öffnen
Set WB_B = Workbooks.Open(strZiel)
'Zielsheet definieren:
Set WsZiel = WB_B.Sheets(1) ' <= wie "richtig" anpassen?
'kopieren:
WsZiel.Range("A:J").Value = WsQuelle.Range("A:J").Value
'Zieldatei speichern und schließen
WB_B.Close savechanges:=True
'Ziel öffnen
Set WB_B = Workbooks.Open(strZiel2)
'Zielsheet definieren:
Set WsZiel = WB_B.Sheets(1) ' <= wie "richtig" anpassen?
'kopieren:
WsZiel.Range("A:J").Value = WsQuelle.Range("A:J").Value
'Zieldatei speichern und schließen
WB_B.Close savechanges:=True
'Ziel öffnen
Set WB_B = Workbooks.Open(strZiel3)
'Zielsheet definieren:
Set WsZiel = WB_B.Sheets(1) ' <= wie "richtig" anpassen?
'kopieren:
WsZiel.Range("A:J").Value = WsQuelle.Range("A:J").Value
'Zieldatei speichern und schließen
WB_B.Close savechanges:=True
'Ziel öffnen
Set WB_B = Workbooks.Open(strZiel4)
'Zielsheet definieren:
Set WsZiel = WB_B.Sheets(1) ' <= wie "richtig" anpassen?
'kopieren:
WsZiel.Range("A:J").Value = WsQuelle.Range("A:J").Value
'Zieldatei speichern und schließen
WB_B.Close savechanges:=True
End SubKann ich jetzt Quasi vor dem Schritt exportieren, einen schritt einfügen, die Tabelle "Füllung" mit der Tabelle "Komplett" zu vergleichen und die Neuerungen anzufügen??
Vielen Dank schon mal im voraus.
Gruß