VBScript: FileDateTime gibt nur 01.01.1998 14:00:00 aus

wayne5de

Level-2
Beiträge
143
Reaktionspunkte
20
Zuviel Werbung?
-> Hier kostenlos registrieren
Hallihallo,
ich würde gerne auf einem Panel alle Dateien die vom aktuellen Tag sind, von einem Ordner in einen anderen Ordner kopieren.

Zum Kopieren habe ich das folgende Skript verwendet:

Für das Suche älterer Dateien das folgende Skript:
Files löschen älter als 30 tage mit VB Script

Code:
Sub Kopieren()
'Tip:
' 1. Verwenden Sie die Tastenkombination <CTRL+SPACE> oder <CTRL+I>, um eine Liste aller Objekte und Funktionen zu öffnen
' 2. Schreiben Sie den Code unter Verwendung des HMI Runtime Objekts.
'  Beispiel: HmiRuntime.Screens("Screen_1").
' 3. Verwenden Sie die Tastenkombination <CTRL+J>, um eine Objektreferenz zu erstellen.
'Schreiben Sie den Code ab dieser Position:


' ####################################################################################################
' Kopiert den gegebenen Ordner in das gegebene Zielverzeichnis. Ein existierender Ordner wird ggf.
' überschrieben. Tritt während der Abarbeitung ein Fehler auf, so werden bereits kopierte Ordner-
' inhalte nicht gelöscht.
'
' HINWEIS: Bei Geräten mit WinCE führt die Existenz von Unterverzeichnissen im Quellordner zu einem
' Fehler!
'
' @param 'sourcePath'      -> Pfad und Name des Quellordners als STRING
' @param 'destinationPath' -> Pfad und Name des Zielordners als STRING
' @param 'overwrite'       -> Überschreibe einen bereits existierenden Ordner als BOOL (wird bei WinCE-Geräten nicht berücksichtigt)
'
'
' -------------------------------------------------------------------------------------------
' |   Version   | Autor | Änderung                                                         
' -------------------------------------------------------------------------------------------
' | 01_00_00_00 |  fk   | Neuerstellung
'
' ####################################################################################################


    ' ##################################################
    ' Variablenreferenzen holen, Funktion initialisieren
    ' ##################################################
    Dim fso, fs
    Dim firstLoop, fileName
    Dim fctStatus
    Dim UtilsFIO_doesFileExist
    Dim quellpfad, zielpfad
    Dim killdate, file
 
    fctStatus = EId_NO_ERROR
    killdate = DateAdd("d", -0, Date)             'Stichdatum: Datum 0 Tage vor heute

    'On Error Resume Next

    quellpfad = "\Storage Card SD\Daten\2023"
    zielpfad = "\Storage Card SD\Transfer"
  
  
    Set fso = CreateObject("FileCtl.FileSystem")
    file = fso.Dir(quellpfad & "*.*")

    UtilsFIO_doesFileExist = False

    ' ##############
    ' Funktionslogik
    ' ##############
  
        Set fs = CreateObject("FileCtl.FileSystem")
        If fs.dir(quellpfad) = "" Then
            fctStatus = EId_FOLDER_DOES_NOT_EXIST
            
        End If
        If fctStatus = EId_NO_ERROR Then
            If fs.Dir(zielpfad) = "" Then
                fs.MkDir zielpfad
                
            End If
            If fs.Dir(zielpfad) = "" Then
                fctStatus = EId_FOLDER_DOES_NOT_EXIST
                
            End If
        End If
        If fctStatus = EId_NO_ERROR Then
            firstLoop = True
            Do
                If firstLoop Then
                    fileName = fs.Dir(quellpfad & "\*.*")
                    firstLoop = False
                    
                Else
                    fileName = fs.Dir
                    
                End If
                If fileName <> "" Then
'                    If UtilsFIO_doesFileExist(zielpfad & "\" & fileName) Then
'                        fs.kill zielpfad & "\" & fileName
'                    End If

                    If fso.FileDateTime(file) < killdate Then  'wenn Dateizeitstempel älter als Stichdatum

                    fs.FileCopy (quellpfad & "\" & fileName), (zielpfad & "\" & fileName)
                    fctStatus = Err.Number
                     ShowSystemAlarm quellpfad & "\" & fileName
                     ShowSystemAlarm zielpfad & "\" & fileName
                     ShowSystemAlarm "FileDate: "& (fso.FileDateTime(file))
                  
                     End If
                  
                    If fctStatus > EId_NO_ERROR Then
                        Exit Do
                    End If
                Else
                    Exit Do
                End If
            Loop
        End If
 
  
  
  
  
    ' ################
    ' Funktionsausgang
    ' ################

    ' Funktionsstatus global bekanntmachen
    SmartTags("fctStatus_global") = fctStatus
 ShowSystemAlarm "killdate: " & (killdate)


    Set fs = Nothing
    Set fso = Nothing

    Err.Clear
    On Error GoTo 0


End Sub


Leider gibt mir fso.FileDateTime(file) immer nur 01.01.1998 14:00:00 aus...

Jemand eine Idee?

Danke und viele Grüße
wayne
 
Zuviel Werbung?
-> Hier kostenlos registrieren
Sodele!
Jetzt werden die Dateien kopiert, die zwischen einen Datum liegen:
Code:
Sub Kopieren()

' ####################################################################################################
' Kopiert den gegebenen Ordner in das gegebene Zielverzeichnis. Ein existierender Ordner wird ggf.
' überschrieben. Tritt während der Abarbeitung ein Fehler auf, so werden bereits kopierte Ordnerinhalte nicht gelöscht.
'
' HINWEIS: Bei Geräten mit WinCE führt die Existenz von Unterverzeichnissen im Quellordner zu einem Fehler!
'
' @param 'sourcePath'      -> Pfad und Name des Quellordners als STRING
' @param 'destinationPath' -> Pfad und Name des Zielordners als STRING
' @param 'overwrite'       -> Überschreibe einen bereits existierenden Ordner als BOOL (wird bei WinCE-Geräten nicht berücksichtigt)
'
'
' ####################################################################################################


    ' ##################################################
    ' Variablenreferenzen holen, Funktion initialisieren
    ' ##################################################
    Dim fso, fs
    Dim firstLoop, fileName
    Dim fctStatus
    Dim UtilsFIO_doesFileExist
    Dim quellpfad, zielpfad
    Dim killdate_0, killdate_1, file
 
    fctStatus = EId_NO_ERROR
    killdate_0 = DateAdd("d", -2, Date)             'Stichdatum: Datum 0 Tage vor heute
    killdate_1 = DateAdd("d", -1, Date) 
    
    'On Error Resume Next

    quellpfad = "\Storage Card SD\Daten\2023"
    zielpfad = "\Storage Card SD\Transfer"
    
    
    Set fso = CreateObject("FileCtl.FileSystem")
    file = fso.Dir(quellpfad & "*.csv")

    UtilsFIO_doesFileExist = False

    ' ##############
    ' Funktionslogik
    ' ##############
    
        Set fs = CreateObject("FileCtl.FileSystem")
        If fs.dir(quellpfad) = "" Then
            fctStatus = EId_FOLDER_DOES_NOT_EXIST
              
        End If
        If fctStatus = EId_NO_ERROR Then
            If fs.Dir(zielpfad) = "" Then
                fs.MkDir zielpfad
                  
            End If
            If fs.Dir(zielpfad) = "" Then
                fctStatus = EId_FOLDER_DOES_NOT_EXIST
                  
            End If
        End If
        If fctStatus = EId_NO_ERROR Then
            firstLoop = True
            Do
                If firstLoop Then
                    fileName = fs.Dir(quellpfad & "\*.*")
                    firstLoop = False
                      
                Else
                    fileName = fs.Dir
                      
                End If
                If fileName <> "" Then
'                    If UtilsFIO_doesFileExist(zielpfad & "\" & fileName) Then
'                        fs.kill zielpfad & "\" & fileName
'                    End If
                                    
                    file = (quellpfad & "\" & fileName)
                    ShowSystemAlarm "FileName: "& (file)
                    
                    If killdate_0 < fso.FileDateTime(file) And fso.FileDateTime(file) < killdate_1 Then  'wenn Dateizeitstempel dazwischen liegt
                        fs.FileCopy (quellpfad & "\" & fileName), (zielpfad & "\" & fileName)
                        fctStatus = Err.Number
                         'ShowSystemAlarm quellpfad & "\" & fileName
                         'ShowSystemAlarm zielpfad & "\" & fileName
                         'ShowSystemAlarm (killdate_0) & "<" & (fso.FileDateTime(file)) & "<" & (killdate_1)                   
                     End If
                    
                    If fctStatus > EId_NO_ERROR Then
                        Exit Do
                    End If
                Else
                    Exit Do
                End If
            Loop
        End If
    
    
    ' ################
    ' Funktionsausgang
    ' ################

    ' Funktionsstatus global bekanntmachen
 'SmartTags("fctStatus_global") = fctStatus
 'ShowSystemAlarm (killdate_0) & "<" & (fso.FileDateTime(file)) & "<" & (killdate_1)

    Set fs = Nothing
    Set fso = Nothing

    Err.Clear
    On Error GoTo 0

End Sub
 
Zurück
Oben