Live-Forum - Die aktuellen Beiträge
Datum
Titel
19.04.2024 21:26:15
mehrfache Texte finden
19.04.2024 19:41:34
Bei VBA Ausführung Anzeige einfrieren
19.04.2024 17:05:40
Zählen von Zeilen, in denen in bestimmten Bereich Daten sind
19.04.2024 16:34:52
gemeinsamer Filter über drei Spalten
Du findest keine passende Antwort auf Deine Frage?
Stelle Deine Frage in unserem Live-Forum
Anzeige
Archiv - Navigation
1200to1204
Aktuelles Verzeichnis
Verzeichnis Index
Übersicht Verzeichnisse
Vorheriger Thread
Rückwärts Blättern
Nächster Thread
Vorwärts blättern
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
Vorheriger Thread
Vorheriger Thread
Rückwärts Blättern
1200to1204
1200to1204
Aktuelles Verzeichnis
Verzeichnis Index
Verzeichnis Index
Übersicht Verzeichnisse
Nächster Thread
Nächster Thread
Vorwärts blättern
Inhaltsverzeichnis

Backup-Service

Backup-Service
Sebastian
Hallo Experten,
ich habe bestimmte Dateien auf dem Rechner, die ich regelmässig sichern möchte.
Händisch ist das ziemlich mühseilig, weil sich die Ausgangsdateien - so wie das im Leben immer ist - natürlich in tausend verschiedenen Ordnern befinden.
Daher bin ich auf Eure Hilfe angewiesen bzw. ich würde mich freuen, wenn einer der VBA-Experten mir sein Fachwissen ausborgen könnte. Ich habe nämlich nur wenig Ahnung von VBA.
Ich beschreibe einfach mal mein Problem und dann kann jeder für sich entscheiden, ob er die Mühe auf sich nimmt.
In einer Datei trage ich in Spalte A ab Zeile 2 die Dateien ein, die gesichert werden. Ich hatte an den kompletten Pfad gedacht, z.B. F:\Privat\Dateien\Test.xls (sämtliche Typen z.B. auch Word sollten möglich sein)
Diese Dateien werden nun in einer Schleife von oben bis unten in einem fest vorgesehen Ordner gespeichert. Der Name soll nur um das Datum der Sicherung (TT.MM.JJJJ) am Ende angereichert werden, weil ich das regelmässig machen möchte. Wichtig ist, dass die gesamte Arbeitsmappe incl. möglicher Makros gesichert wird.
Das wäre die Beschreibung und jetzt hoffe ich einfach, dass jemand von Euch experten die Idee vielleicht gut findet und mir helfen würde.
Vielen Dank im Voraus!
Sebastian

15
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Benutzer
Anzeige
Backup Tool
01.03.2011 10:44:59
Christian
Hallo Sebastian,
nun, mit vba nein wird das wohl nicht einfach...
Aber warum das Rad neu erfinden? Es gibt doch genügend Tools, wie zB "robocopy" von Mircosoft.
Ist free, läuft auf der Commandline und auch unter XP.
Gruß
Christian
AW: Backup-Service
01.03.2011 10:49:57
Martin
Hallo Sebastian,
wenn du mit VBA einverstanden bist, dann programmiere ich es dir. Bitte teile mir nur mit welches das Zielverzeichnis der Sicherungsdateien sein soll.
Viele Grüße
Martin
AW: Backup-Service
01.03.2011 10:55:52
Ramses
Hallo
Probier mal
Die Datei muss so aufgebaut sein
Tabelle1

 ABC
1Backup Files Zielordner
2d:\Test.doc d:\Backup\
3d:\Ordner\word.doc  
4x:\Ordner\excel.xls  
5   


Excel Tabellen im Web darstellen >> Excel Jeanie HTML 4
Den Code in ein Modul deiner Mappe kopieren und starten
Option Explicit

Sub Copy_Files_based_on_Excel_Sheet()
    '(c) Ramses
    On Error GoTo myErrorHandler
    Dim i As Long, cr As Long, cc As Long
    Dim wks As Worksheet
    Dim tarCFolder As String
    Dim myFs As Object
    'Erstellen des FileSystemObjectes
    Set myFs = CreateObject("Scripting.FileSystemObject")
    'Tabelle wo die Filenamen stehen
    Set wks = Worksheets("Tabelle1")
    'Spalte in der die Pfadnamen stehen
    cc = 1
    'Letzten Eintrag in der Spalte festlegen
    cr = Cells(65536, cc).End(xlUp).Row
    'In diesen Ordner sollen die Dateien kopiert werden
    'mit Backslash am Schluss
    'tarCFolder = "D:\DeinZielordner\"
    'oder alternativ den Zielordner aus einer Zelle nehmen
    tarCFolder = Range("C2").Text
    'Kopierschleife starten
    '2 wenn die Pfadnamen in Zeile 2 beginnen,
    'sonst ab welcher Zeile die Filenamen beginnen
    For i = 2 To cr
        myFs.CopyFile Cells(i, cc).Text, tarCFolder
    Next i
    'Fehlerbehandlung
    MyErrorExit:
    Exit Sub
    
    myErrorHandler:
    MsgBox (Err.Number & ": " & Err.Description)
    Resume MyErrorExit
End Sub

Das ist eine ganz einfache Variante ohne grossen Kommfort
Gruss Rainer
Anzeige
AW: Backup-Service
01.03.2011 17:26:20
Sebastian
Hallo Ramses,
funktioniert einwandfrei.
Vielen Dank!
Viele Grüße
Sebastian
Doch noch zwei Bitten
01.03.2011 22:10:49
Sebastian
Hallo Ramses,
lässt es sich einrichten, dass die Sicherheitskopie noch das Tagesdatum am Ende erhält, damit ich erkennen kann, wann die Datei gesichert wurde?
Weiterhin die Frage, ob es mit nicht so grossen Aufwand möglich ist, den Status in der Tabelle (in der das Makro gespeichert ist) einzutragen, sprich: Datei wurde gesichert, oder Datei wurde nicht gefunden.
Wäre sowas machbar? Frage auch mal in die Runde, da Du mir ja schon sehr geholfen hast.
Vielen Dank!
Viele Grüße
Sebastian
Anzeige
AW: Doch noch zwei Bitten
01.03.2011 22:55:02
Ramses
Hallo
probier mal
Option Explicit

Sub Copy_Files_based_on_Excel_Sheet()
    '(c) Ramses
    On Error GoTo myErrorHandler
    Dim i As Long, cr As Long, cc As Long
    Dim wks As Worksheet
    Dim tarCFolder As String, fName As String, fileExt As String
    Dim myFs As Object
    'Erstellen des FileSystemObjectes
    Set myFs = CreateObject("Scripting.FileSystemObject")
    'Tabelle wo die Filenamen stehen
    Set wks = Worksheets("Tabelle1")
    'Spalte in der die Pfadnamen stehen
    cc = 1
    'Letzten Eintrag in der Spalte festlegen
    cr = Cells(65536, cc).End(xlUp).Row
    'In diesen Ordner sollen die Dateien kopiert werden
    'mit Backslash am Schluss
    'tarCFolder = "D:\DeinZielordner\"
    'oder alternativ den Zielordner aus einer Zelle nehmen
    tarCFolder = Range("C2").Text
    'Kopierschleife starten
    '2 wenn die Pfadnamen in Zeile 2 beginnen,
    'sonst ab welcher Zeile die Filenamen beginnen
    For i = 2 To cr
        If Dir(Cells(i, cc).Text) = "" Then
            Cells(i, cc + 1) = "Datei nicht gefunden"
        Else
            fName = Cells(i, cc).Text
            fName = Right(fName, Len(fName) - InStr(1, fName, "\"))
            fileExt = Right(fName, Len(fName) - InStrRev(fName, "."))
            myFs.CopyFile Cells(i, cc).Text, tarCFolder & Left(fName, Len(fName) - (Len(fileExt) + 1)) & "_" & Format(Date, "yyyy-mm-dd") & "." & fileExt
        End If
    Next i
    'Fehlerbehandlung
    MyErrorExit:
    Exit Sub
    
    myErrorHandler:
    MsgBox (Err.Number & ": " & Err.Description)
    Resume MyErrorExit
End Sub

GrusS Rainer
Anzeige
AW: Doch noch zwei Bitten
02.03.2011 13:40:28
Sebastian
Hallo Ramses,
hat leider etwas länger gedauert - weil ich einen Fehlerhinweis erhalten habe. Lag an mir. :-)
Es funktioniert reibungslos.
Besten Dank!
Viele Grüße
Sebastian
AW: Doch noch zwei Bitten
02.03.2011 13:40:31
Sebastian
Hallo Ramses,
hat leider etwas länger gedauert - weil ich einen Fehlerhinweis erhalten habe. Lag an mir. :-)
Es funktioniert reibungslos.
Besten Dank!
Viele Grüße
Sebastian
Shit, ein Problem
02.03.2011 19:45:51
Sebastian
Hallo Ramses, hallo ggf. die anderen,
kann es sein, dass das Makro Leerzeichen bzw. längere Pfad mit mehreren "\" nicht sauber erkennen. Ich bekomme immer einen Fehlerhinweis "76 Pfad nicht gefunden". Ist es eine kurze Pfadangabe z.B.
F:\Privat\Mappe.xls läuft es sauber.
Oder sitzt das Problem vor dem PC?
VIele Grüße
Sebastian
Anzeige
AW: Shit, ein Problem
02.03.2011 21:14:12
Ramses
Hallo
zeig mal einen Pfad mit Dateinamen bei dem das nicht funktionieren sollte
Grus Rainer
AW: Shit, ein Problem
03.03.2011 12:07:52
Sebastian
Hallo Ramses,
hat leider etwas länger gedauert, weil ich erst jetzt zur Arbeit gekommen bin (wir haben in Köln Karneval und muss ich habe Spätdienst). :-(
Hier ein Beispiel:
W:\Org_Team\Team1_Leitung\Test Sebastian (auf keinen Fall löschen)\1 Excel-Vorlagen\Mappe1.xls
Besten Dank für Deine Hilfe!
Gruß
Sebastian
PS: Wie kriegst Du eigentlich immer so schnell mit, dass ich geschrieben habe? Gibt es da eine Einstellung?
Probier mal....
03.03.2011 22:45:37
Ramses
Hallo
probier mal das aus
Option Explicit

Private Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)

Sub Copy_Files_based_on_Excel_Sheet()
    '(c) Ramses
    On Error GoTo myErrorHandler
    Dim i As Long, cr As Long, cc As Long, n As Long
    Dim wks As Worksheet
    Dim tarCFolder As String, fName As String, fileExt As String
    Dim myFs As Object
    Dim chkFile As Boolean
    'Erstellen des FileSystemObjectes
    Set myFs = CreateObject("Scripting.FileSystemObject")
    'Tabelle wo die Filenamen stehen
    Set wks = Worksheets("Tabelle1")
    'Spalte in der die Pfadnamen stehen
    cc = 1
    'Letzten Eintrag in der Spalte festlegen
    cr = Cells(65536, cc).End(xlUp).Row
    'In diesen Ordner sollen die Dateien kopiert werden
    'mit Backslash am Schluss
    'tarCFolder = "D:\DeinZielordner\"
    'oder alternativ den Zielordner aus einer Zelle nehmen
    tarCFolder = Range("C2").Text
    'Kopierschleife starten
    '2 wenn die Pfadnamen in Zeile 2 beginnen,
    'sonst ab welcher Zeile die Filenamen beginnen
    For i = 2 To cr
        'Eine Schleife wird 5 mal durchlaufen um langsamen Laufwerken Zeit zu geben zu antworten
        'Nach der Prüfung wird 250 mS gewartet um dem Betriebssystem zeit zu geben
        'Kontakt zum Netzlaufwerk herzustellen
        For n = 1 To 5
            If Dir(Cells(i, cc).Text) <> "" Then
                chkFile = True
            Else
                chkFile = False
            End If
            If chkFile = True Then Exit For
            Sleep 250
        Next n
        If chkFile = False Then
            Cells(i, cc + 1) = "Datei nicht gefunden"
        Else
            'Die nächste Zeile ist zum testen um den Fehler zu finden
            MsgBox "Die Datei existiert", vbOKOnly, "Test"
            '******************
            fName = Cells(i, cc).Text
            fName = Right(fName, Len(fName) - InStr(1, fName, "\"))
            fileExt = Right(fName, Len(fName) - InStrRev(fName, "."))
            myFs.CopyFile Cells(i, cc).Text, tarCFolder & Left(fName, Len(fName) - (Len(fileExt) + 1)) & "_" & Format(Date, "yyyy-mm-dd") & "." & fileExt
        End If
    Next i
    'Fehlerbehandlung
    MyErrorExit:
    Exit Sub
    
    myErrorHandler:
    MsgBox (Err.Number & ": " & Err.Description)
    Resume MyErrorExit
End Sub

Wenn das nicht hilft und der Fehler immer noch auftritt NACH der MsgBox dass die Datei existiert, muss ich das FileSystemObjekt umgehen für den Kopiervorgang.
Gruss Rainer
Anzeige
AW: Probier mal....
04.03.2011 20:35:03
amintire
Hallo Rainer,
habe es mal Spaßhalber getestet und funktioniert nicht.
Wenn es z.B. W:\Org_Team.xls heißt dann schon, aber sobald eine zweite \ dazu kommt, erscheint immer noch der Fehler "76: Pfad nicht gefunden".
PS:
Wäre es vielleicht nicht praktischer mit "Datei existiert" anstatt jede Datei abzufragen ob die exisitiert, nur diejenigen abfragen welche nicht existieren? Ansonsten wäre man bei tausend von Dateien übelst mit klicken beschäftigt, evtl. auch dann in der Excel Tabelle diejenigen farblich markieren welche nicht existieren.
Nur ein Vorschlag.
Lieben Gruß
und ein schönes Wochenende
Amina
Anzeige
So geht es...
06.03.2011 14:30:26
Ramses
Hallo
"...Ansonsten wäre man bei tausend von Dateien übelst mit klicken beschäftigt..:"
Das soll ja auch nur zum testen sein um rauszufinden wo der Fehler liegt.
Mit deinem Hinweis habe ich den Fehler gefunden :-)
Option Explicit

Private Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)

Sub Copy_Files_based_on_Excel_Sheet()
    '(c) Ramses
    On Error GoTo myErrorHandler
    Dim i As Long, cr As Long, cc As Long, n As Long
    Dim wks As Worksheet
    Dim tarCFolder As String, fName As String, fileExt As String
    Dim myFs As Object
    Dim chkFile As Boolean
    'Erstellen des FileSystemObjectes
    Set myFs = CreateObject("Scripting.FileSystemObject")
    'Tabelle wo die Filenamen stehen
    Set wks = Worksheets("Tabelle1")
    'Spalte in der die Pfadnamen stehen
    cc = 1
    'Letzten Eintrag in der Spalte festlegen
    cr = Cells(65536, cc).End(xlUp).Row
    'In diesen Ordner sollen die Dateien kopiert werden
    'mit Backslash am Schluss
    'tarCFolder = "D:\DeinZielordner\"
    'oder alternativ den Zielordner aus einer Zelle nehmen
    tarCFolder = Range("C2").Text
    'Kopierschleife starten
    '2 wenn die Pfadnamen in Zeile 2 beginnen,
    'sonst ab welcher Zeile die Filenamen beginnen
    For i = 2 To cr
        'Eine Schleife wird 5 mal durchlaufen um langsamen Laufwerken Zeit zu geben zu antworten
        'Nach der Prüfung wird 250 mS gewartet um dem Betriebssystem zeit zu geben
        'Kontakt zum Netzlaufwerk herzustellen
        For n = 1 To 5
            If Dir(Cells(i, cc).Text) <> "" Then
                chkFile = True
            Else
                chkFile = False
            End If
            If chkFile = True Then Exit For
            Sleep 250
        Next n
        If chkFile = False Then
            Cells(i, cc + 1) = "Datei nicht gefunden"
        Else
            'Die nächste Zeile ist zum testen um den Fehler zu finden
            'MsgBox "Die Datei existiert", vbOKOnly, "Test"
            '******************
            fName = Cells(i, cc).Text
            fName = Right(fName, Len(fName) - InStrRev(fName, "\"))
            fileExt = Right(fName, Len(fName) - InStrRev(fName, "."))
            myFs.CopyFile Cells(i, cc).Text, tarCFolder & Left(fName, Len(fName) - (Len(fileExt) + 1)) & "_" & Format(Date, "yyyy-mm-dd") & "." & fileExt
        End If
    Next i
    'Fehlerbehandlung
    MyErrorExit:
    Exit Sub
    
    myErrorHandler:
    MsgBox (Err.Number & ": " & Err.Description)
    Resume MyErrorExit
End Sub

Gruss Rainer
Anzeige
@ Rainer: Jetzt funktioniert es....
06.03.2011 19:27:48
Sebastian
perfekt. Vielen Dank!

Beliebteste Forumthreads (12 Monate)

Anzeige
Jetzt das Excel-Portal bewerten: Deine Stimme zählt!

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige