24.07.2010, aktualisiert am 18.10.2012

7067

Alte Dateien auf anderes Medium verschieben und einen Link erstellen

Hallo Community,
ich nutze administrator.de seit langer Zeit für meine tägliche Arbeit und habe hier VIEL Hilfe gefunden.

Ich habe leider zuwenig Ahnung von VB als das ich sowas selbst schreiben könnte, deshalb hier meine Frage an Euch:

Seit einiger Zeit mache ich damit rum, alte Dateien von einem Medium auf ein anderes per VB oder Batch zu verschieben, die Struktur im "Archiv" zu belassen UND gleichzeitig einen Link im Quellverzeichnis zu hinterlassen.

Habt Ihr eine Idee?

Laufwerksquellen

Originaldaten:
p:\Daten

Archivierungsdaten:
q:\Daten

Vielen Dank für Eure Hilfe und Vorschläge

Bitte markiere auch die Kommentare, die zur Lösung des Beitrags beigetragen haben

Content-ID: 147586

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

Ausgedruckt am: 08.11.2024 um 21:11 Uhr

15 Kommentare

Neuester Kommentar

Hallo ceng.de,

1. Betreffend des Erzeugens von Verknüpfungen: Suchfunktion des Forums nutzen

2. Wie definierst Du "alt"? Erstellungsdatum/Datum der letzten Änderung vor einem bestimmten Datum oder liegt eine bestimmte Zeitspanne zurück oder älter als eine andere Version der Datei an einem anderen Ort?

3. Auszug aus bestehendem Code.

4. Hoffe nicht auf eine Fertiglösung.

Gruß
Friemler

Zitat von @Friemler:

Hallo ceng.de,

1. Betreffend des Erzeugens von Verknüpfungen: Suchfunktion des Forums nutzen

- hast Du einen Link zu einem Eintrag? Ich habe bisher nichts gefunden.

2. Wie definierst Du "alt"? Erstellungsdatum/Datum der letzten Änderung vor einem bestimmten Datum oder liegt eine
bestimmte Zeitspanne zurück oder älter als eine andere Version der Datei an einem anderen Ort?

- die Datei delage32.exe ( F:\Sicherung\Logs\*.* 7 /recurse /created /rd) erfüllt schon seit erheblicher Zeit für mich den Zweck die "alten" Dateien zu löschen. Ich nutze sie in einem Batchfile.

3. Auszug aus bestehendem Code.

- ich habe nur die Batchdatei, die funktioniert eben mit delage. Jetzt soll aber die datei nicht gelöscht, sondern verschoben werden (geht auch mit delage32) aber ich hätte gerne einen Link auf die verschobene Datei im originalverzeichnis, da die Mitarbeiter die Dateien nicht suchen sollen, sondern direkt auf das andere Medium verbunden werden sollen.

4. Hoffe nicht auf eine Fertiglösung.

- Ein Ansatz in VB würde mir vll. helfen... Eine Fertiglösung wäre natürlich noch schöner

, aber daran glaube ich auch nicht...

Gruß
Friemler

Vielleicht nochmal zum Konzept der Idee...

Ich würde gerne Dateien deren Änderungsdatum X-Tage zurückliegt per Batch / VB auf ein anderes Medium / Laufwerk verschieben und anstatt der Originaldatei einen Link erstellen.

Hallo ceng.de,

wenn Du schon delage32 verwendest, dann bleib doch bei Batch. Leite die Ausgabe von delage32 in eine Datei um, die Du mit einer FOR /F Schleife auseinander dröselst. Im Forum finden sich wie gesagt VBS-Schnipsel, die eine Verküpfung anlegen. Den Schnipsel führst Du innerhalb der FOR /F Schleife aus. Andere Beispiele im Forum zeigen, wie man ein temporäres VBScript aus einer Batchdatei erzeugt und ausführt.

[Edit]
Batch Verknüpfung erstellen mit Parametern
http://msdn.microsoft.com/en-us/library/xsy6k3ys%28VS.85%29.aspx

Gruß
Friemler

Ja... Ja... Ja...

Delage /preview als Input für das VB-Script... könnte gehen...

makescut.exe könnte an der stelle evtl. auch helfen...

Ein ganz anderer Ansatz, aber könnte echt gehen....

Danke erstmal Friemler...

Vll. hat ja jemand dennoch DAS fertige Script...

Hallo ceng.de

eventuell hier etwas in Nur-VBS.
Darauf kannst du aufbauen!

Dim Pfadangabe, PfadNeu
dim ProgName, LinkPfad
Dim ObjShell

Dim objShortcut

Pfadangabe = "D:\3\"  
PfadNeu = "D:\4\"  

set fs = createobject("Scripting.FileSystemObject")  

ListOrdner (Pfadangabe)

Sub ListOrdner(Pfadangabe)
	Set ordner = fs.getfolder(Pfadangabe)

	For Each file In ordner.files
		
		Pfadangabe =File.path

		temp = Split(Pfadangabe , "\")  

		ProgName = temp(Ubound(temp))
		LinkPfad = Pfadangabe
		
		FS.MoveFile Pfadangabe , PfadNeu

		LinkAnlegen
	Next

End Sub

Sub LinkAnlegen()

Set ObjShell = CreateObject("WScript.Shell")  

  strLPfad = LinkPfad
  Set objShortcut=objShell.CreateShortcut(strLPfad & ".lnk")  
  objShortcut.TargetPath= PfadNeu & ProgName

  objShortcut.Save

End Sub

Gruss und schönes WE

Tsuki

THX Tsuki...

Ein guter Schritt!! Funktioniert und kann bestimmt weiterhelfen...

Momentan wird natürlich "nur" die Dateien im angegebene Ordner verlinkt und nicht in den Unterverzeichnissen. Die Verlinkung klappt aber hier herrvorragend. Kann ich das ganze noch recursive nach unten hinkriegen?

Kann ich das ganze noch recursive nach unten hinkriegen?

Wenn du dir in meinem Schnipsel ab Zeile 30 folgende Zeilen einfügst:
(noch in der SUB ListOrdner!)

For Each Unterordner In Ordner.subfolders
		Pfadangabe = unterordner.path
		
		Listordner unterordner
next

dann kannst du auch die Unterordner durchsuchen und Dateien verschieben, bzw. verlinken lassen.

Gruss
Tsuki

Ich hänge gerade daran:
- wie ich im Unterverzeichnis die gleiche Ordnerstruktur erstelle wie im Originalverzeichnis...
- ob das Logdatei-Object nicht vollaufen kann, wenn viele tausend Dateien verschoben werden
- ob das Script nicht an einer oder anderer Stelle optimiert werden kann

Ideen?

Danke
CENG

SCRIPT V2 Stand 26.07.2010

' [content:147586#580079]  
' Script zum Verschieben von "alten" Dateien in ein anderes Verzeichnis und Link im Originalverzeichnis erstellen  
' THX Tsuki ([content:79798])  
' THX Friemler ([content:91808])  


Dim OrgPfad, ArcPfad, Logdatei
Dim Logbucheintrag, Logbuchkopf, trennlinie
Dim DatName, LinkPfad
Dim ObjShell

Dim objShortcut

'Angabe mit Backslash "\" -> Bsp: c:\programme\  

OrgPfad = "C:\ArchivTest\OrigDat\"  
ArcPfad = "C:\ArchivTest\ArcDat\"  
logdatei = "C:\ArchivTest\archivierung-"&Date()&".txt"  
trennlinie = "*****************************************"  


'Subroutine Ordner ArcPfad vorhanden  
Archivordnerpruefung

set fs = createobject("Scripting.FileSystemObject")  

ListOrdner (OrgPfad)

'''''''''''''''''''''''''''''''''''''''''''''''''''  
' Logfile Bearbeitung                             '  
'''''''''''''''''''''''''''''''''''''''''''''''''''  
Dim objFSO
Set objFSO = CreateObject("Scripting.FileSystemObject")  

' Logeintrag schreiben  
	Const ForReading = 1
	Const ForWriting = 2

'Prüfung, ob Logdatei vorhanden, ansonsten erstelle mit Datum in Kopfzeile  
  If (objFSO.FileExists(logdatei)) Then
	Set open_File = objFSO.OpenTextFile(logdatei, 8)
    	open_File.Close()
	Else
    	Set open_File = objFSO.OpenTextFile(logdatei, 2, "True")  
    	open_File.Close()
	End If

	Set objLogFile = objFSO.OpenTextFile(Logdatei, ForWriting, TRUE)
		Logbuchkopf = trennlinie & vbCrLf _
    	& "Datum der Archivierung: " & Date() & vbCrLf _  
    	& trennlinie & vbCrLf

		objLogFile.Write Logbuchkopf & Logbucheintrag
	' Schliesse Logdatei  
		objLogFile.Close

'''''''''''''''''''''''''''''''''''''''''''''''''''  
'' Verschieben der Dateien                       ''  
'''''''''''''''''''''''''''''''''''''''''''''''''''  

Sub ListOrdner(OrgPfad)

Dim objFSO
Set objFSO = CreateObject("Scripting.FileSystemObject")  

Set ordner = fs.getfolder(OrgPfad)

	For Each file In ordner.files

		OrgPfad = File.path
		temp = Split(OrgPfad , "\")  
		DatName = temp(Ubound(temp))
		Wscript.echo "Datei in Bearbeitung: " & DatName  
		Logbucheintrag = Logbucheintrag & vbCrLf & Time () & " " & OrgPfad  

	' Dateien tatsächlich verschieben  
		LinkPfad = OrgPfad
        FS.MoveFile OrgPfad , ArcPfad
        'Subroutine Link für verschobene Datei anlegen  
        LinkAnlegen

	Next

' Suche der Dateien in Unterordner  
	For Each Unterordner In Ordner.subfolders
		OrgPfad = unterordner.path
		Wscript.echo "Unterpfad existiert: "  
		Wscript.echo "Pfad: " & OrgPfad  

	' Lese auch in Unterordnerstruktur  
		Listordner unterordner

	Next

End Sub

'''''''''''''''''''''''''''''''''''''''''''''''''''  
'' Prüfung ob Archivordner vorhanden             ''  
'''''''''''''''''''''''''''''''''''''''''''''''''''  

Sub Archivordnerpruefung()
Dim Ordner

Set fs = CreateObject("Scripting.FileSystemObject")  
	If Not fs.FolderExists(ArcPfad) Then
    	fs.CreateFolder (ArcPfad)
	Else
		'nix machen  
    End If
End Sub

'''''''''''''''''''''''''''''''''''''''''''''''''''  
'' für jede verschoben Datei link anlegen        ''  
'''''''''''''''''''''''''''''''''''''''''''''''''''  

Sub LinkAnlegen()

Set ObjShell = CreateObject("WScript.Shell")  

  strLPfad = LinkPfad
  Set objShortcut=objShell.CreateShortcut(strLPfad & ".lnk")  
  objShortcut.TargetPath= ArcPfad & DatName
  objShortcut.Save

End Sub

Hallo ceng.de

- wie ich im Unterverzeichnis die gleiche Ordnerstruktur erstelle wie im Originalverzeichnis...

Hierzu mal ein profanes Beispiel:
Ich möchte die gleiche Ordnerstruktur von C: auf D: übernehmen und es ist egal,
wieviele Ordner davon schon existieren:

OrgPfad = "C:\TestNeu\1\2\3\"  
ArcPfad = "D:"  

Set FSO = CreateObject("Scripting.FileSystemObject")  

tempfolder = split(OrgPfad , "\")  

For i = 1 to Ubound(tempfolder)
On error resume next

	ArcPfad= ArcPfad  & "\" & tempfolder(i)  
	Set OrdnerPfadNeu = FSO.CreateFolder(ArcPfad)

Next

Du müßtest dann einfach (in deiner Sub Archivordnerpruefung() ) den Laufwerksbuchstaben vom Originalpad ersetzen in den, vom Archivpfad.
Diese Information stände beim Spiltten dann im 0-ten Array (in meinem Beispiel wäre das tempfolder(0) ).
Anschließend den Rest vom Orignalpfad an den Archivpfad übergeben und das ganze wieder "zusammendröseln".
Ähnlich, wie in meinem Beispiel.

Bestehende Dateien im Archivpfad werden hierbei nicht überschrieben!

Probier's mal aus

Gruss
Tsuki

Ps.: Wenn du alle Funktionen hast in deinem Script, dann schauen wir zum Schluß mal nach Kosmetik

Sch...ade, ich glaube, ich habe mich jetzt total verrannt und habe den Überblick verloren...

Ich versuche gerade die "simple" Integration des Codeschnipsels von Tsuki (übrigens @tsuki: VIELEN DANK FÜR DIE HILFE). Scheint total einfach zu sein, aber für einen Batchprogrammierer wie mich (hihi Programmierer -> besser BatchzusammentippseraufniedrigstemNiveau) ist es garnicht so einfach, mit multidimensionalen Arrays zu hantieren...

Momentan kopiert das Script die Dateien aus dem ersten Verzeichnis und geht dann mit dem ExitCode 0 aus dem Script.

BTW: ich habe gerade Proton und "VbsEdit 4.6.1.0 - 64-bit version" als "Programmierumgebung" gibt es da etwas besseres und für einen "Anfänger" auch geeignetes Werkzeug?

' [content:147586#580079]  
' Version archivierungV03.vbs  
' Script zum Verschieben von "alten" Dateien in ein anderes Verzeichnis und Link im Originalverzeichnis erstellen  
' THX Tsuki ([content:79798])  
' THX Friemler ([content:91808])  


Dim OrgPfad, ArcPfad, ArchPfad
Dim Logdatei, Logbucheintrag, Logbuchkopf, trennlinie
Dim DatName, LinkPfad
Dim ObjShell

Dim objShortcut

'Angabe mit Backslash "\" -> Bsp: c:\programme\  

OrgPfad = "C:\ArchivTest\OrigDat\"  
OrgPfadstart = OrgPfad
ArcPfad = "C:\ArchivTest\ArcDat\"  
logdatei = "C:\ArchivTest\archivierung-"&Date()&".txt"  
trennlinie = "*****************************************"  


'Subroutine: Ordner ArcPfad vorhanden?  
Archivordnerpruefung

set fs = createobject("Scripting.FileSystemObject")  

ListOrdner (OrgPfad)

'''''''''''''''''''''''''''''''''''''''''''''''''''  
' Logfile Bearbeitung                             '  
'''''''''''''''''''''''''''''''''''''''''''''''''''  
Dim objFSO
Set objFSO = CreateObject("Scripting.FileSystemObject")  

' Logeintrag schreiben  
	Const ForReading = 1
	Const ForWriting = 2

'Prüfung, ob Logdatei vorhanden, ansonsten erstelle mit Datum in Kopfzeile  
  If (objFSO.FileExists(logdatei)) Then
	Set open_File = objFSO.OpenTextFile(logdatei, 8)
    	open_File.Close()
	Else
    	Set open_File = objFSO.OpenTextFile(logdatei, 2, "True")  
    	open_File.Close()
	End If

	Set objLogFile = objFSO.OpenTextFile(Logdatei, ForWriting, TRUE)
		Logbuchkopf = trennlinie & vbCrLf _
    	& "Datum der Archivierung: " & Date() & vbCrLf _  
    	& trennlinie & vbCrLf

		objLogFile.Write Logbuchkopf & Logbucheintrag
	' Schliesse Logdatei  
		objLogFile.Close

'''''''''''''''''''''''''''''''''''''''''''''''''''  
'' Verschieben der Dateien                       ''  
'''''''''''''''''''''''''''''''''''''''''''''''''''  

Sub ListOrdner(OrgPfad)

Dim objFSO
Set objFSO = CreateObject("Scripting.FileSystemObject")  

Set ordner = fs.getfolder(OrgPfad)

	For Each file In ordner.files

		OrgPfad = File.path

   Next 
 
				  
		OrgPfadDatname = Split(OrgPfad , "\")  
		DatName = OrgPfadDatname(Ubound(OrgPfadDatname))
		Wscript.echo "Datei: " & OrgPfad & " -> " & Archpfad  
		Logbucheintrag = Logbucheintrag & vbCrLf & Time () & " " & OrgPfad  

	' Dateien tatsächlich verschieben  
		LinkPfad = OrgPfad
        FS.MoveFile OrgPfad , ArchPfad
      'Subroutine: Link für verschobene Datei anlegen  
        LinkAnlegen



' Suche der Dateien in Unterordner  
	For Each Unterordner In Ordner.subfolders
		OrgPfad = unterordner.Path
		
	'Archivpfad anpassen  
		WScript.Echo trennlinie
		arctempfolder = OrgPfad
		arctempfolderstrArray = Split(arctempfolder, Orgpfadstart)
		For i = 1 to (Ubound(arctempfolderstrArray))-1
		ArchPfad = ArcPfad & arctempfolderstrArray(i)
		    WScript.echo "Archivpfadneu: " & ArcPfad & arctempfolderstrArray(i) & " (Array:" & i &")"  
		    WScript.echo "OK"  
			WScript.Echo trennlinie
		Next
		
'		Wscript.echo "Unterpfad existiert: "  
		Wscript.echo "OrgPfad: " & OrgPfad  
		Wscript.echo "ArchPfad: " & ArchPfad  

	' Lese auch in Unterordnerstruktur  
		Listordner unterordner

	Next

End Sub

'''''''''''''''''''''''''''''''''''''''''''''''''''  
'' Archivstruktur vorbereiten                    ''  
'''''''''''''''''''''''''''''''''''''''''''''''''''  

'Sub SplitPathFromFile()  
'  Dim Pfad  
'  
'  Pfad = Orgpfad  
'  While right$(Pfad, 1) <> "\" And _  
'   right$(Pfad, 1) <> ":" And Pfad <> ""  
'    Pfad = left$(Pfad, Len(Pfad) - 1)  
'  Wend  
'  If right$(Pfad, 1) = "\" Then _  
'    Pfad = left$(Pfad, Len(Pfad) - 1)  
'  
'  Archivpfad = Pfad  
'End Sub  

'''''''''''''''''''''''''''''''''''''''''''''''''''  
'' Prüfung ob Archivordner vorhanden             ''  
'''''''''''''''''''''''''''''''''''''''''''''''''''  

Sub Archivordnerpruefung()
Dim Ordner

Set fs = CreateObject("Scripting.FileSystemObject")  
	If Not fs.FolderExists(ArcPfad) Then
    	fs.CreateFolder (ArcPfad)
	Else
		'nix machen  
    End If
    

'tempfolder = split(OrgPfad , "\")  

'For i = 1 to Ubound(tempfolder)  
'On error resume next  

'	ArcPfadNeu= ArcPfad  & "\" & tempfolder(i)  
'	Set OrdnerPfadNeu = FSO.CreateFolder(ArcPfad)  
'	wscript.echo "Neuer ArchivpfadArcPfadNeu  
'	wscript.echo Ordnerpfadneu   
'Next  

'Set fs = CreateObject("Scripting.FileSystemObject")  
'	If Not fs.FolderExists(OrgPfad) Then  
'    	wscript.echo "Originalverzeichnisangabe fehlerhaft!"  
'		wscript.echo OrgPfad  
'		Logbucheintrag = Logbucheintrag & vbCrLF & "Originalverzeichnisangabe fehlerhaft!"  
'	Else  
'		'nix machen  
'   End If  

End Sub

'''''''''''''''''''''''''''''''''''''''''''''''''''  
'' für jede verschoben Datei link anlegen        ''  
'''''''''''''''''''''''''''''''''''''''''''''''''''  

Sub LinkAnlegen()

Set ObjShell = CreateObject("WScript.Shell")  

  strLPfad = LinkPfad
  Set objShortcut=objShell.CreateShortcut(strLPfad & ".lnk")  
  objShortcut.TargetPath= ArcPfad & DatName
  objShortcut.Save

End Sub

Hallo ceng.de

Sch...ade, ich glaube, ich habe mich jetzt total verrannt und habe den Überblick verloren...

In so einem Fall mache ich immer folgendes:
1) ich hol’ mir ‚nen Kaffee
2) Ich besorg mir auf’m Rückweg von der Küche einen Stift und etwas Malpapier

3) Dann schreibe ich mir nochmal alles gaaannzz langsam auf

Du möchtest:
Dateien von einem Platz in einen anderen verschieben
In den alten Ordnern nur noch die Links ablegen, die auf die Dateien zeigen
In den neuen Ordner(n) die alte Ordnerstruktur anlegen/beibehalten
Und das ganze in einem Logfile (was dann gewisse Abläufe „mitschreibt) speichern.

Fangen wir mal an:
Den Vorkopf lassen wir so, wie er schon ist

' [content:147586#580079]  
' Version archivierungV03.vbs  
' Script zum Verschieben von "alten" Dateien in ein anderes Verzeichnis und Link im Originalverzeichnis erstellen  
' THX Tsuki ([content:79798])  
' THX Friemler ([content:91808])  


Dim OrgPfad, ArcPfad, ArchPfad
Dim Logdatei, Logbucheintrag, Logbuchkopf, trennlinie
Dim DatName, LinkPfad
Dim ObjShell
Dim objFSO , Fs
Dim objShortcut
Dim ArrOrig , ArrArch

'Angabe mit Backslash "\" -> Bsp: c:\programme\  

OrgPfad = "C:\Test\"  
OrgPfadstart = OrgPfad
ArcPfad = "D:\Archiv"  
logdatei = "D:\archivierung-" & Date() & ".txt"  
trennlinie = "*****************************************"  

Dann lesen wir uns erst einmal (Warum auch nicht?) alle Pfade und vorhanden Dateien ein und schreiben diese in Variablen

Set objFSO = CreateObject("Scripting.FileSystemObject")  
set fs = createobject("Scripting.FileSystemObject")  

ListOrdner OrgPfad


Sub ListOrdner(OrgPfad)

Set ordner = fs.getfolder(OrgPfad)

' Suche nach allen Dateien im jeweiligen Pfad  
' und speichere diese in einer Variable ab.  
' Außer, es handelt sich um einen LINK!  
	For Each Datei In ordner.files
		If Not LCase(Right(Datei.Path,3)) = Lcase("lnk") then  
			ArrOrig = ArrOrig & Datei.Path & vbcrlf
			ArrArch = ArrArch & Datei.Path & vbcrlf
		End If

   	Next 
 
' Suche nach Unterordner  
	For Each Unterordner In Ordner.subfolders
	
		Listordner unterordner

	Next

End Sub

Dann noch in Arrays geschoben. Da können wir später mittels FOR-Schleifen jede Menge Scriptzeilen sparen

' Bringe die Variablen in ein Array  
	ArrOrig = Split(ArrOrig ,vbcrlf)
	ArrArch = Split(ArrArch ,vbcrlf)

Jetzt schon vielleicht die Archivpfad-Informationen ablegen in ein Array

' Gib dem Archiv-Array die richtigen Anfangsdaten bezüglich des Ablagepfades  
For i = 0 to Ubound(ArrArch)
If Not ArrArch(i) = "" then  
	temp = Split(ArrArch(i), "\")  
	temp(0) = ArcPfad
	ArrArch(i) = join(temp , "\")  
End If
Next

Und schon können wir die Ordner anlegen, wohin später die Dateien hingeschubst werden sollen

' jetzt legen wir uns - falls nötig! - die Ordner im Archivpfad an  
For i = 0 to Ubound(ArrArch)
	On Error resume next

temp = ArcPfad
Set OrdnerPfadNeu = FS.CreateFolder(temp)

	temp1 = Split(ArrArch(i), "\")  
	temp1(Ubound(temp1)) = ""  
	temp2 = ArcPfad
	for k = 2 to Ubound(temp1)
		On Error resume next
		temp2 = temp2 & "\" & temp1(k)  
		Set OrdnerPfadNeu = FS.CreateFolder(temp2)
	Next

Next

So, bis hierhin haben wir noch nicht viel kaputt gemacht

Jetzt können wir auch schon die Dateien verschieben:

'jetzt können wir die Dateien verschieben  
For i = 0 to Ubound(ArrOrig)
If Not ArrOrig(i) = "" Then  
	FS.MoveFile ArrOrig(i) , ArrArch(i)
	'Fuer das Logfile  
	Logbucheintrag = Logbucheintrag & Time () & "Datei: " & ArrOrig(i) & " verschoben nach: " & ArrArch(i) & vbcrlf  
End If
Next

Was fehlt nach dem Verschieben? Rochtig! Die Links müssen erstellt werden.
Wir haben alle Infos ja noch in unseren Arrays J

'und zum Schluss legen wir uns noch die Links an  
  Set ObjShell = CreateObject("WScript.Shell")  
For i = 0 to Ubound(ArrOrig)
If Not ArrOrig(i) = "" then  
  strLPfad = ArrOrig(i)
  Set objShortcut=objShell.CreateShortcut(strLPfad & ".lnk")  
  objShortcut.TargetPath= ArrArch(i)
  objShortcut.Save
End If
Next

So, jetzt haben wir’s soweit erst mal. Aber, genau! Das Logfile fehlt noch:

'achso, jetzt soll auch noch ein Logfile angelegt werden.  
  If (objFSO.FileExists(logdatei)) Then
	Set open_File = objFSO.OpenTextFile(logdatei, 8)
    	open_File.Close()
	Else
    	Set open_File = objFSO.CreateTextFile(logdatei,True)
    	open_File.Close()
	End If

	Set objLogFile = objFSO.OpenTextFile(Logdatei, 8)
	Logbuchkopf = trennlinie & vbCrLf _
    	& "Datum der Archivierung: " & Date() & vbCrLf _  
    	& trennlinie & vbCrLf

	objLogFile.Write (Logbuchkopf & Logbucheintrag)
	' Schliesse Logdatei  
	objLogFile.Close

Und zum Schluß natürlich...

Set objFSO = Nothing
set fs = Nothing
Set ObjShell = Nothing

Msgbox "Durch!"  

So, ceng.de, jetzt haben wir erst einmal deine Anforderungen soweit erfüllt.
Was jetzt noch kommt ist Kosmetik und Vereinfachung. Ich habe mal alles etwas langatmig geschrieben, damit man besser die Gedankengänge verfolgen kann.
Sicher läßt sich einiges verkürzen/schöner schreiben.
Aber.....

Gruss
Tsuki

Ps.: Das ganze sieht jetzt so aus:

' [content:147586#580079]  
' Version archivierungV03.vbs  
' Script zum Verschieben von "alten" Dateien in ein anderes Verzeichnis und Link im Originalverzeichnis erstellen  
' THX Tsuki ([content:79798])  
' THX Friemler ([content:91808])  


Dim OrgPfad, ArcPfad, ArchPfad
Dim Logdatei, Logbucheintrag, Logbuchkopf, trennlinie
Dim DatName, LinkPfad
Dim ObjShell
Dim objFSO , Fs
Dim objShortcut
Dim ArrOrig , ArrArch

'Angabe mit Backslash "\" -> Bsp: c:\programme\  

OrgPfad = "C:\Test\"  
OrgPfadstart = OrgPfad
ArcPfad = "D:\Archiv"  
logdatei = "D:\archivierung-" & Date() & ".txt"  
trennlinie = "*****************************************"  

Set objFSO = CreateObject("Scripting.FileSystemObject")  
set fs = createobject("Scripting.FileSystemObject")  

ListOrdner OrgPfad


Sub ListOrdner(OrgPfad)

Set ordner = fs.getfolder(OrgPfad)

' Suche nach allen Dateien im jeweiligen Pfad  
' und speichere diese in einer Variable ab.  
' Außer, es handelt sich um einen LINK!  
	For Each Datei In ordner.files
		If Not LCase(Right(Datei.Path,3)) = Lcase("lnk") then  
			ArrOrig = ArrOrig & Datei.Path & vbcrlf
			ArrArch = ArrArch & Datei.Path & vbcrlf
		End If

   	Next 
 
' Suche nach Unterordner  
	For Each Unterordner In Ordner.subfolders
	
		Listordner unterordner

	Next

End Sub

' Bringe die Variablen in ein Array  
	ArrOrig = Split(ArrOrig ,vbcrlf)
	ArrArch = Split(ArrArch ,vbcrlf)

' Gib dem Archiv-Array die richtigen Anfangsdaten bezüglich des Ablagepfades  
For i = 0 to Ubound(ArrArch)
If Not ArrArch(i) = "" then  
	temp = Split(ArrArch(i), "\")  
	temp(0) = ArcPfad
	ArrArch(i) = join(temp , "\")  
End If
Next

' jetzt legen wir uns - falls nötig! - die Ordner im Archivpfad an  
For i = 0 to Ubound(ArrArch)
	On Error resume next

temp = ArcPfad
Set OrdnerPfadNeu = FS.CreateFolder(temp)

	temp1 = Split(ArrArch(i), "\")  
	temp1(Ubound(temp1)) = ""  
	temp2 = ArcPfad
	for k = 2 to Ubound(temp1)
		On Error resume next
		temp2 = temp2 & "\" & temp1(k)  
		Set OrdnerPfadNeu = FS.CreateFolder(temp2)
	Next

Next

'jetzt können wir die Dateien verschieben  
For i = 0 to Ubound(ArrOrig)
If Not ArrOrig(i) = "" Then  
	FS.MoveFile ArrOrig(i) , ArrArch(i)
	'Fuer das Logfile  
	Logbucheintrag = Logbucheintrag & Time () & "Datei: " & ArrOrig(i) & " verschoben nach: " & ArrArch(i) & vbcrlf  
End If
Next


'und zum Schluss legen wir uns noch die Links an  
  Set ObjShell = CreateObject("WScript.Shell")  
For i = 0 to Ubound(ArrOrig)
If Not ArrOrig(i) = "" then  
  strLPfad = ArrOrig(i)
  Set objShortcut=objShell.CreateShortcut(strLPfad & ".lnk")  
  objShortcut.TargetPath= ArrArch(i)
  objShortcut.Save
End If
Next

'achso, jetzt soll auch noch ein Logfile angelegt werden.  
  If (objFSO.FileExists(logdatei)) Then
	Set open_File = objFSO.OpenTextFile(logdatei, 8)
    	open_File.Close()
	Else
    	Set open_File = objFSO.CreateTextFile(logdatei,True)
    	open_File.Close()
	End If

	Set objLogFile = objFSO.OpenTextFile(Logdatei, 8)
	Logbuchkopf = trennlinie & vbCrLf _
    	& "Datum der Archivierung: " & Date() & vbCrLf _  
    	& trennlinie & vbCrLf

	objLogFile.Write (Logbuchkopf & Logbucheintrag)
	' Schliesse Logdatei  
	objLogFile.Close


Set objFSO = Nothing
set fs = Nothing
Set ObjShell = Nothing

Msgbox "Durch!"  

Hi Tsuki,

ich glaube, das Script hat einen Fehler im Bereich:

For i = 0 to Ubound(ArrArch)
If Not ArrArch(i) = "" then  
	temp = Split(ArrArch(i), "\")  
	temp(0) = ArcPfad
	ArrArch(i) = join(temp , "\")  
End If

Dort wird der Archivordner doch wieder zusammengesetzt (Join) und das Ergebnis ist falsch:
Nach dem ArchPfad wird der OrgPfad angehängt, aber mit zwei \ "Backslashs" getrennt (wahrscheinlich einer vom ArchPfad und einer vom join (temp , "\")...

-> Damit kann keine Datei verschoben werden, allerdings werden die Ordner unterhalb von ArchPfad sauber angelegt...

(Hier der Auszug aus dem Logfile

)

17:15:38 Datei: C:\ArchivTest\OrigDat\ACME.EXE verschoben nach: C:\ArchivTest\ArcDat\\ArchivTest\OrigDat\ACME.EXE
17:15:38 Datei: C:\ArchivTest\OrigDat\ACMSETUP.EXE verschoben nach: C:\ArchivTest\ArcDat\\ArchivTest\OrigDat\ACMSETUP.EXE

d.h. wenn ich Richtig liege (bitte um Bestätigung), dann muß ich an dieser Stelle schauen, daß ich das zweite "\" rausbekomme.

Und an der Stelle

'jetzt können wir die Dateien verschieben  
	Wsscript.echo "Verschiebe Start"  
	
For i = 0 to Ubound(ArrOrig)
If Not ArrOrig(i) = "" Then  
	Wsscript.echo "Verschiebe " & ArrOrig (i) & "nach " & ArrArch (i)  
	FS.MoveFile ArrOrig(i) , ArrArch(i)
	'Fuer das Logfile  

bin ich mir auch nicht sicher, ob es so geht. Weder die Echo Zeile oben, noch die unten werden angezeigt. Geht das Script überhaupt dorthin, oder biegt es irgenwo vorher ab?

Hallo ceng.de

in meinem Script oben in Zeile 20 darf als

ArcPfad = "D:\Archiv"

kein Backslash am Ende sein!!!! Dann würden beide Teile (Ordneranlegen/Dateien verschieben) nicht
funktionieren, da du dann doppelte Backslashes erhälst.
Das kann man aber auch noch ziemlich oben am Script (eventuell Zeile 26) abfangen mit:

If Right(ArcPfad,1) = "\" then ArcPfad = Left(ArcPfad , Len(ArcPfad) - 1)  

Somit bekämen wir in deinem Beispiel

C:\ArchivTest\ArcDat\

den letzten Backslash ganz rechts wieder weg.

Probier das mal oder setze

ArcPfad = C:\ArchivTest\ArcDat

gleich ganz ohne Backslash am Anfang deines Scriptes
So hattes es bei mir im Test bestens funktioniert!

Kopier mal meinen zuletzt geposteten Code Schnipsel (unter Ps.:) und teste den mal!

Gruss
Tsuki

Hallo ceng.de

Mir ist noch etwas aufgefallen!
Bei meinem Test hier habe ich als Archivordner folgenden Pfad zum Testen ausgewählt

ArcPfad = „D:\Archiv“

In diesem Falle funktioniert meine Scriptvortgabe, selbst wenn der Ordner ARCHIV noch nicht existiert auf dem Zielpfad. Dann wird er erst einmal angelegt. Aber du möchtest ja zum Beispiel es so haben

ArcPfad = „D:\Archiv\Ablage\MeineDateien“ usw.

Wenn diese Ordner noch nicht existieren, haben wir ein Problem

Aber wir können einen Griff in die Trickkiste wagen und starten das Script mal so durch. Hierbei wird ein kleines Fenster aufgemacht, wo der Benutzer erst einmal den Zielpfad auswählen muss. Ggf. kann/können über dieses kleine Fenster ein neuer/neue Ordner erstellt werden.

Dieses kleine Code-Schnipselchen (Ordner auswählen) ist übrigens hier aus dem Forum von unserem bastla J

' [content:147586#580079]  
' Version archivierungV03_1.vbs  
' Script zum Verschieben von "alten" Dateien in ein anderes Verzeichnis und Link im Originalverzeichnis erstellen  
' THX Tsuki ([content:79798])  
' THX Friemler ([content:91808])  
' THX bastla ()  


Dim OrgPfad, ArcPfad, ArchPfad
Dim Logdatei, Logbucheintrag, Logbuchkopf, trennlinie
Dim DatName, LinkPfad
Dim ObjShell
Dim objFSO , Fs
Dim objShortcut
Dim ArrOrig , ArrArch

'Angabe mit Backslash "\" -> Bsp: c:\programme\  

OrgPfad = "C:\Test\"  
OrgPfadstart = OrgPfad
ArcPfad = "D:\Archiv"  
logdatei = "D:\archivierung-" & Date() & ".txt"  
trennlinie = "*****************************************"  

‚ oeffnet ein Dialogfenster zur Auswahl eines Ordners
AuswahlTitel = "Bitte Archivordner auswählen"  
StartOrdner = "17"  
Set Auswahl = CreateObject("Shell.Application").BrowseForFolder(0,AuswahlTitel,16,StartOrdner)  
If TypeName(Auswahl) = "Nothing" Then  
    MsgBox "Abbruch gewählt!"  
    WScript.Quit
Else
    Set Ordner = Auswahl.Self
    ArcPfad = Ordner.Path
End If

Set objFSO = CreateObject("Scripting.FileSystemObject")  
set fs = createobject("Scripting.FileSystemObject")  

ListOrdner OrgPfad

Sub ListOrdner(OrgPfad)

Set ordner = fs.getfolder(OrgPfad)

' Suche nach allen Dateien im jeweiligen Pfad  
'  und speichere diese in einer Variable ab.  
' Außer, es handelt sich um einen LINK!  
	For Each Datei In ordner.files
		If Not LCase(Right(Datei.Path,3)) = Lcase("lnk") then  
			ArrOrig = ArrOrig & Datei.Path & vbcrlf
			ArrArch = ArrArch & Datei.Path & vbcrlf
		End If

   	Next 
 
' Suche nach Unterordner  
	For Each Unterordner In Ordner.subfolders
	
		Listordner unterordner

	Next

End Sub

' Bringe die Variablen in ein Array  
	ArrOrig = Split(ArrOrig ,vbcrlf)
	ArrArch = Split(ArrArch ,vbcrlf)

' Gib dem Archiv-Array die richtigen Anfangsdaten bezüglich des Ablagepfades  
For i = 0 to Ubound(ArrArch)
If Not ArrArch(i) = "" then  
	temp = Split(ArrArch(i), "\")  
	temp(0) = ArcPfad
	ArrArch(i) = join(temp , "\")  
End If
Next

' jetzt legen wir uns - falls nötig! - die Ordner im Archivpfad an  
For i = 0 to Ubound(ArrArch)
	On Error resume next

temp = ArcPfad
Set OrdnerPfadNeu = FS.CreateFolder(temp)

	temp1 = Split(ArrArch(i), "\")  
	temp1(Ubound(temp1)) = ""  
	temp2 = ArcPfad
	ZaehlerAnfang = Split(ArcPfad , "\")  
	for k = (Ubound(ZaehlerAnfang) + 1) to Ubound(temp1)
		On Error resume next
		temp2 = temp2 & "\" & temp1(k)  
		Set OrdnerPfadNeu = FS.CreateFolder(temp2)
	Next

Next

'jetzt können wir die Dateien verschieben  
For i = 0 to Ubound(ArrOrig)
If Not ArrOrig(i) = "" Then  
	FS.MoveFile ArrOrig(i) , ArrArch(i)
	'Fuer das Logfile  
	Logbucheintrag = Logbucheintrag & Time () & "Datei: " & ArrOrig(i) & " verschoben nach: " & ArrArch(i) & vbcrlf  
End If
Next


'und zum Schluss legen wir uns noch die Links an  
  Set ObjShell = CreateObject("WScript.Shell")  
For i = 0 to Ubound(ArrOrig)
If Not ArrOrig(i) = "" then  
  strLPfad = ArrOrig(i)
  Set objShortcut=objShell.CreateShortcut(strLPfad & ".lnk")  
  objShortcut.TargetPath= ArrArch(i)
  objShortcut.Save
End If
Next

'achso, jetzt soll auch noch ein Logfile angelegt werden.  
  If (objFSO.FileExists(logdatei)) Then
	Set open_File = objFSO.OpenTextFile(logdatei, 8)
    	open_File.Close()
	Else
    	Set open_File = objFSO.CreateTextFile(logdatei,True)
    	open_File.Close()
	End If

	Set objLogFile = objFSO.OpenTextFile(Logdatei, 8)
	Logbuchkopf = trennlinie & vbCrLf _
    	& "Datum der Archivierung: " & Date() & vbCrLf _  
    	& trennlinie & vbCrLf

	objLogFile.Write (Logbuchkopf & Logbucheintrag)
	' Schliesse Logdatei  
	objLogFile.Close


Set objFSO = Nothing
set fs = Nothing
Set ObjShell = Nothing

Msgbox "Durch!"  

teste diesen Code mal so, wie er ist. Dann bereden wir Feinheiten später. Dieser Schnipsel hat bei mir ohne Probleme funktioniert und folgende Sachen durchgeführt:
1) Archivpfad auswählen und ggf. Ordner anlegen
2) Alle Dateien im Originalverzeichnis erfassen und dann verschieben, solange es keine Links sind
3) Zum Schluss ein Logfile anlegen.

(WinXP Pro Eng)

Gruss
Tsuki

Frage VB for Applications Entwicklung

Mehr von ceng.de

Httaccess auf Strato Server - Umleitung des Benutzers nach erfolgreichem Login - rewriteceng.de

Timeline - Gantt Chart mit Microsoft Access - DrawLineceng.de

Recdisc.exe - Systemreparaturdatenträger auf Netzwerkfreigabeceng.de - 4 Kommentare

SCHTASKS - Commandline für Core Server - Parameterceng.de - 5 Kommentare

Heiß diskutiert