Zeitstempel an kopierter Datei
Hallo,
ich kopiere aus einer Quelle Dateien an unterschiedliche Ordner. Dieses Script wird mehrmals am Tag ausgeführt. Die Dateinamen sind dabei immer gleich.
Da diese Dateien beim Verschieben immer wieder überschrieben werden (case 2) , möchte ich hier einen Zeitstempel anhängen. Leider funktioniert das nicht richtig.
Hat jemand einen Tipp?
Danke und Gruss
Michael
ich kopiere aus einer Quelle Dateien an unterschiedliche Ordner. Dieses Script wird mehrmals am Tag ausgeführt. Die Dateinamen sind dabei immer gleich.
Da diese Dateien beim Verschieben immer wieder überschrieben werden (case 2) , möchte ich hier einen Zeitstempel anhängen. Leider funktioniert das nicht richtig.
Hat jemand einen Tipp?
Danke und Gruss
Michael
Option Explicit
function Main
' Variablendeklaration
Dim objShell, wshShell, objNetwork, objFile, fso, Verzeichnis, Filename, FileArt, File
Dim arArten(1, 3) 'Array für Dateiarten
Dim Z, S 'As Integer 'Indizes für Array Z=Zeile, S=Spalte
Dim copyDate , copyTime
Set objShell = CreateObject("Shell.Application")
Set wshShell = CreateObject("WScript.Shell")
Set objNetwork = CreateObject("WScript.Network")
Set objFile = CreateObject("Scripting.FileSystemObject")
Set fso = CreateObject("Scripting.FileSystemObject")
Const quelle = "C:\TEMP\"
'+----------------------------------------------------------------------------------+'
'| Array 11 Zeilen - 3 Spalten |'
'| Spalte 1 = Dateiname Stelle 1-4 |'
'| Spalte 2 = 0=Löschen, 1=Kopieren, 2=Verschieben |'
'| Spalte 3 = Zielverzeichnis |'
'+----------------------------------------------------------------------------------+'
'| Dimensionieren |'
'+----------------------------------------------------------------------------------+'
'Dim arArten
'+----------------------------------------------------------------------------------+'
'| Zeilenzähler setzen |'
'+----------------------------------------------------------------------------------+'
Z = 0
'+----------------------------------------------------------------------------------+'
'| Array füllen + Zeilenzähler erhöhen |'
'| Art(0) AKTION(1) Zielverzeichnis(2) ZÄHLER++ |'
'+----------------------------------------------------------------------------------+'
arArten(Z, 0) = "TST_": arArten(Z, 1) = "2": arArten(Z, 2) = "D:\TEMP" :Z = Z + 1
' Ermitteln der Zeitdaten
copyDate = Date()
copyTime = Time()
'rArten(Z, 0) = "": arArten(Z, 1) = "": arArten(Z, 2) = "":
'+----------------------------------------------------------------------------------+'
'| Check Verzeichnisse |'
'+----------------------------------------------------------------------------------+'
If Not objFile.FolderExists(quelle) Then
MsgBox "Quellverzeichnis: " & quelle & " nicht vorhanden"
Exit Function
End If
For Z = 0 To UBound(arArten, 1)
If arArten(Z, 0) <> "" Then
If Not objFile.FolderExists(arArten(Z, 2)) Then
MsgBox "Für Art: " & arArten(Z, 0) & " ist das Zielverzeichnis " & arArten(Z, 2) & " nicht vorhanden"
Exit Function
End If
End If
Next
'+----------------------------------------------------------------------------------+'
'| Datei-Aktion |'
'+----------------------------------------------------------------------------------+'
Set Verzeichnis = objFile.GetFolder(quelle)
Set fso = CreateObject("Scripting.FileSystemObject")
For Each objFile In Verzeichnis.Files
Filename = objFile.Name
FileArt = UCase(Left(Filename, 4))
For Z = 0 To UBound(arArten, 1)
If FileArt = arArten(Z, 0) Then
Dim x 'As String
x = quelle & "\" & Filename
Set File = fso.GetFile(x)
Select Case arArten(Z, 1)
Case "0" 'Löschen in Quellverzeichnis
'x.Delete
Case "1" 'Kopieren in Zielverzeichnis
File.Copy arArten(Z, 2), true
Case "2" 'Verschieben nach Zielverzeichnis
if fso.FileExists( arArten(Z, 2) & Filename) then
fso.DeleteFile(arArten(Z, 2) & Filename)
end if
fso.movefile x, arArten(Z, 2) & Filename &" " & copyDate & " " & copyTime
End Select
End If
Next
Next
end function
Main
Bitte markiere auch die Kommentare, die zur Lösung des Beitrags beigetragen haben
Content-ID: 265337
Url: https://administrator.de/contentid/265337
Ausgedruckt am: 25.11.2024 um 15:11 Uhr
4 Kommentare
Neuester Kommentar