bacaaardi
Goto Top

xls ins Archiv verschieben

Hallo ich versuche ein Skript zu bauen in dem aus den Dateien daten.xls und info.xls jeweils immer die ersten 3 Zeilen und die letzte Zeile gelöscht wird.


Jeden Tag speichern wir eine neue daten.xls und info.xls in den Ordner.
Dabei werden die Dateien vom Vortag überschrieben. Ist es möglich anstatt die Daten zu überschreiben, die „alten“ Daten in den Ordner „Archiv“ zu verschieben am Besten mit dem Datum vor dem Dateinamen, z.B. 18.09.07_daten.xls und 18.09.07_info.xls.
Die neuen Daten heissen dann weiterhin daten.xls und info.xls nur der „Altbestand“ wird in den Ordner Archiv verschoben mit dem Datumszusatz.

Optimal wäre es wenn dies in 1 Schritt passieren würde, Zeilen löschen und archivieren ;)


Gruß Julia

Content-Key: 68938

Url: https://administrator.de/contentid/68938

Ausgedruckt am: 29.03.2024 um 11:03 Uhr

Mitglied: bastla
bastla 18.09.2007 um 17:52:32 Uhr
Goto Top
Hallo Bacaaardi!

Das Archivieren selbst ist rein handwerklich etwa so zu lösen:
Sub Archivieren()
Dim fso As Object, Dat As String, Dateien() As Variant, Datei As Variant

Const Arbeit As String = "D:\Arbeitsordner" 'Quellordner  
Const Archiv As String = "D:\Archivordner"  'Zielordner  
Dateien = Array("daten", "info")            'Liste der Dateien  

Set fso = CreateObject("Scripting.FileSystemObject")  
Dat = Format(Now, "YYYY-MM-DD") 'Datumsformat hier festlegen  
For Each Datei In Dateien()
    If fso.FileExists(Arbeit & "\" & Datei & ".xls") Then  
        fso.CopyFile Arbeit & "\" & Datei & ".xls", Archiv & "\" & Dat & "_" & Datei & ".xls", True  
        fso.DeleteFile (Arbeit & "\" & Datei & ".xls")  
    End If
Next
End Sub
Gleichnamige Dateien (vom selben Tag) im Archivordner werden in dieser Version durch die umbenannten Dateien aus dem Arbeitsordner überschrieben. Als Datumsformat würde ich allerdings eher zu "2007-09-18" tendieren (und habe es oben auch so verwendet). Dieses lässt sich aber leicht ändern (siehe "Format(...)").

Das "Verschieben" wird als Kombination von "Kopieren" (mit Überschreiben schon vorhandener Zieldateien) und nachfolgendem Löschen der Quelldateien ausgeführt, wobei eine etwas sicherere Variante anstatt die kopierten Dateien zu löschen diese einfach von den nachfolgenden Dateien überschreiben ließe.
Zum Thema "aus den Dateien daten.xls und info.xls jeweils immer die ersten 3 Zeilen und die letzte Zeile löschen" wäre anzumerken, dass Excel-Dateien keine Zeilen enthalten, sondern etwa Tabllenblätter mit Zeilen, und dass ich ohne zusätzliche Informationen als die "ersten 3 Zeilen" die Zeilen 1 bis 3 und als "letzte Zeile" die Zeile 65536 oder ihr Excel 2007-Pendant betrachten würde (was ja vermutlich nicht gemeint sein dürfte face-wink) ...

Grüße
bastla
Mitglied: Bacaaardi
Bacaaardi 19.09.2007 um 08:16:28 Uhr
Goto Top
Und das ist ein Makro welches ich in Excel einfügen soll??
Mitglied: Bacaaardi
Bacaaardi 19.09.2007 um 09:25:24 Uhr
Goto Top
Vielen Dank, hat im Test teilweise geklappt (wobei der Fehler sicher bei mir liegt ;)

Leider hat mein Chef die Forderung umgeschmissen.

er will jetzt folgendes

Ich hab eine Datei Statistik.xls, dies macht über ein Makro 2 Webabfragen und speichert eine als daten.xls und die andere als info.xls ab. (Konnte die Webabfrage jetzt allein automatisieren, freu ;)

Da diese beiden Dateien aber berits vom Vortag bestehen, sollen die vorhandenen mit Datum im Dateinamen in der Ordner Archiv verschoben werden und die des aktuellen Tags im "normalen" Ordner als daten.xls und info.xls


Hier mein Makro (kann man die Archivierung hier einbauen??) Wenn ja wie
Als eigenes Makro, oder im gleichen Makro wie die Webabfrage?

Sub Makro4()
'  
' Makro4 Makro  
' Makro am 19.09.2007 von mir aufgezeichnet  
'  

'  
Workbooks.Add
With ActiveSheet.QueryTables.Add(Connection:= _
"URL;http://meinedomain.de" _  
, Destination:=Range("A1"))  
.Name = _
"order=DESC&tempMax=3000&os_username=xxx&os_password=xxx"  
.FieldNames = True
.RowNumbers = False
.FillAdjacentFormulas = False
.PreserveFormatting = True
.RefreshOnFileOpen = False
.BackgroundQuery = True
.RefreshStyle = xlInsertDeleteCells
.SavePassword = False
.SaveData = True
.AdjustColumnWidth = True
.RefreshPeriod = 0
.WebSelectionType = xlSpecifiedTables
.WebFormatting = xlWebFormattingNone
.WebTables = """issuetable"""  
.WebPreFormattedTextToColumns = True
.WebConsecutiveDelimitersAsOne = True
.WebSingleBlockTextImport = False
.WebDisableDateRecognition = False
.WebDisableRedirections = False
.Refresh BackgroundQuery:=False
End With
Range("A1:K1").Select  
Selection.Font.Bold = True
With Selection
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlBottom
.WrapText = False
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With
With Selection.Interior
.ColorIndex = 15
.Pattern = xlSolid
End With
Range("A2").Select  
ChDir "C:\Dokumente und Einstellungen\ich\Desktop"  
ActiveWorkbook.SaveAs Filename:= _
"C:\Dokumente und Einstellungen\ich\Desktop\arvato.xls", FileFormat:= _  
xlNormal, Password:="", WriteResPassword:="", ReadOnlyRecommended:=False _  
, CreateBackup:=False
ActiveWindow.Close
End Sub
Mitglied: bastla
bastla 19.09.2007 um 14:24:35 Uhr
Goto Top
Hallo Bacaaardi!

Vielen Dank, hat im Test teilweise geklappt ...
Das ist wenigstens einmal ein Feedback, mit dem man etwas anfangen kann ... face-wink

Hier mein Makro (kann man die Archivierung hier einbauen??)
Obwohl nicht wirklich zu erkennen ist, an welcher Stelle die beiden Dateien gespeichert werden: ja - solange Du die Archivierung vorher machst face-wink.

Grüße
bastla

P.S.: Ich nehme an, Dein anderer Thread könnte mit einen Verweis auf diesen hier abgeschlossen werden ...
Mitglied: Bacaaardi
Bacaaardi 21.09.2007 um 09:12:01 Uhr
Goto Top
Also mein Chef hat die komplett Forderung umgeschmissen face-smile


Ich mache jetzt aus meiner Datei ein Makro (über Button) welches mir eine neue Webabfrage erzeugt.
Es wird ein neues xls geöffnet, die Web-Daten werden importiert. Und dann wird die Datei als daten.xls gespeichert.

Klappt alles wunderbar. Aber face-smile da diese Webafrage 1mal täglich gemacht wird und diese immer als daten.xls gespeichtert werden soll. muss die daten.xls vom Vortag archiviert werden bevor Sie von der aktuellen überschrieben wird.
D.h. die Datei muss mit Datumspräfix+Dateiname in den Ordner Archiv verschoben werden.
Und ganz wichtig die ersten 3 und die letzte Zeile müssen NICHT gelöscht werden. Die Webafrage leifert mir das Format welches ich benötige ;) Kann man hier die Archvierung einbauen?


Es ist nämlich so:

Die Datei daten.xls wird benötigt um Pivot-Auswertungen zu machen. Wenn ich die neue Datei jedes mal mit Datum speichere muss ich jedes mal die Pivot-Abfragen anpassen

Die neue Datei muss immer als Daten.xls gespeichert werden, da aber immer eine daten.xls schon da ist, muss die alte nur mit Datum + Dateinamen in den Ordner Archiv verschoben werden.

Es muss immer eine daten.xls geben, nämlich immer die aktuelle bis zur nächsten Webabfrage.

es bringt mir also nix die Datei nur mit Datum zu speichern. Die aktuelle muss immer daten.xls heissen, und nur die "alten" müssen bevor sie ja quasi von der neuen date.xls überschrieben werden, mit Datum in den Ordner Archiv verschoben werden


Hier mein bisheriges Makro:

Sub Makro2()
'  
' Makro2 Makro  
' Makro am 21.09.2007 von mir aufgezeichnet  
'  

'  
    Workbooks.Add
    With ActiveSheet.QueryTables.Add(Connection:= _
        "URL;http://jira.de/jira/secure/IssueNavigator.jspa?reset=true&&type=-2&pid=10221&sorter/field=issuekey&sorter/order=DESC&tempMax=2000&os_username=user&os_password=password" _  
        , Destination:=Range("A1"))  
        .Name = _
        "order=DESC&tempMax=2000&os_username=username&os_password=password"  
        .FieldNames = True
        .RowNumbers = False
        .FillAdjacentFormulas = False
        .PreserveFormatting = True
        .RefreshOnFileOpen = False
        .BackgroundQuery = True
        .RefreshStyle = xlInsertDeleteCells
        .SavePassword = False
        .SaveData = True
        .AdjustColumnWidth = True
        .RefreshPeriod = 0
        .WebSelectionType = xlSpecifiedTables
        .WebFormatting = xlWebFormattingNone
        .WebTables = """issuetable"""  
        .WebPreFormattedTextToColumns = True
        .WebConsecutiveDelimitersAsOne = True
        .WebSingleBlockTextImport = False
        .WebDisableDateRecognition = False
        .WebDisableRedirections = False
        .Refresh BackgroundQuery:=False
    End With
    ChDir _
        "J: \test\Graphiken"  
    ActiveWorkbook.SaveAs Filename:= _
        "J: \test\Graphiken\daten.xls" _  
        , FileFormat:=xlNormal, Password:="", WriteResPassword:="", _  
        ReadOnlyRecommended:=False, CreateBackup:=False
    ActiveWindow.Close
End Sub
Mitglied: bastla
bastla 21.09.2007 um 13:16:37 Uhr
Goto Top
Hallo Bacaaardi!

Kann man hier die Archvierung einbauen?
Immer noch: ja.

Grüße
bastla