Zum Inhalt springen

Empfohlene Beiträge

Geschrieben

Hallo Leute,

will ein Programm in VB schreiben, dass mir Dateien löscht, die älter als X-Tage sind.

Diese Dateien befinden sich im gleichen Verzeichnis, wie meine erstellte batch-Datei.

"Sobald ich die batch-Datei laufen lasse, sollen mir alle Dateien, die älter sind als X-Tage gelöscht werden."

Hab schon mit dem Programm angefangen, komm aber nicht mehr weiter.

Warte auf eure Hilfe!!!!!!!!:rolleyes:

Danke!

Geschrieben

da musste mal deinen bisherigen quellcode schicken (bitte mit komentaren, die beschreiben was er machen soll), damit man dir weiterhelfen kann.

so ließt man nur im kaffeesatz. beschreibe auch mal an welcher stelle du hängst.

Geschrieben

ja ein wenig mehr Infos wären angenehm.

Zum löschen von Dateien musst Du z.B. die Microsoft Scripting Runtime als Referenz einbinden. Hast Du das gemacht?????

Oder hängt es beim erhalten der Dateiinfos????

Also ein wenig mehr Infos sonst kann Dir auch keiner helfen!

Geschrieben

Hallo Leute,

komm mit meinem Programm einfach nicht mehr weiter.

Mein erstellter Quellcode:

Private Sub Load ()

Dim pfad as String //Variablendeklaration

Dim dat as Date

Dim tage as Date

pfad = "batch.Datei" //Wertevergabe

dat = Date

tage = DateAdd("D",-2,dat)

dateidatum = Format(FileDateTime(pfad)), "DD.MM.YY") //Lese Dateidatum

While Do

If (dateidatum <= tage) then // wiederhole solange bis EOF

// wenn Dateidatum älter 2 Tage, lösche Datei

kill "*.txt"

End if

Exit Do

Loop

End sub

Mit diesem Programm sollte erreicht werden, dass Dateien, die älter als 2 Tage sind automatisch gelöscht werden. Diese Dateien sollen alle in dem gleichen Verzeichnis

sein, wie meine batch-Datei.

Sobald ich die batch-Datei doppeltklicke soll das VB_Programm ablaufen.

Bekomme das einfach nicht auf die Reihe.

Wäre nett, wenn mir auch jemand sagen könnte was ich in die batch-Datei schreiben muss.

Danke!!!

  • 2 Wochen später...
Geschrieben



Const KILLDAYS = 2
Const KILLTYP = "*.txt"
Const KILLDEBUG = True

Sub Main()
Call runKiller(App.Path)
End Sub

Private Sub runKiller(ByRef strPfad As String)
Dim strTmpFilename As String

'// liste der killtyps-files

strPfad = IIf(Right(strPfad, 1) = "\", strPfad, strPfad + "\")
strTmpFilename = Dir(strPfad + KILLTYP, 63)
Do While CBool(Len(strTmpFilename))

'// datei wird geprüft und ggf. gelöscht
If proofDate(strTmpFilename) Then
If KILLDEBUG Then
MsgBox strPfad + strTmpFilename
Else
Call Kill(strPfad + strTmpFilename)
End If
End If

strTmpFilename = Dir
Loop
End Sub

Private Function proofDate(ByRef strFilename As String) As Boolean
proofDate = proofDate2(strFilename, Now)
End Function

Private Function proofDate2(ByRef strFilename As String, ByVal dCurrentDate As Date) As Boolean
'// tag von heute + 2 - prüfdatum
If Format((DateAdd("D", 2, dCurrentDate) - FileDateTime(strFilename)), "D") < KILLDAYS Then
proofDate2 = True
Else
proofDate2 = False
End If
End Function

[/PHP]

fyi. hatte keine lust den code zu testen...

// :uli

die meisten aus diesem forum haben ihren beruf verfehlt...

Geschrieben

Hier mein Beispiel-Code:



Sub Main()

    call DAP

End Sub



Private Sub DAP()

    Dim FSO As FileSystemObject

    Dim Datei As File

    Dim Dateien As Files

    Dim Ordner As Folder

    Dim sDateiName As String

    Dim sPfad As String

    Dim DateiDatum As Date



    DateiDatum = DateAdd("D", lALTER, Format(Now, "dd.mm.yyyy"))

    sPfad = App.Path

    Set FSO = New FileSystemObject

    Set Ordner = FSO.GetFolder(sPfad)

    Set Dateien = Ordner.Files


    For Each Datei In Dateien

        sDateiName = sPfad + "\" + Datei.Name

        If UCase(FSO.GetExtensionName(sDateiName)) = "TXT" Then

            If Format(FSO.GetFile(sDateiName).DateCreated, "dd.mm.yyyy") <  DateiDatum Then

                If Datei.Attributes And ReadOnly = ReadOnly Then

                    Datei.Attributes = Datei.Attributes And Not ReadOnly

                End If

                FSO.DeleteFile (sDateiName)

            End If

        End If

    Next


    Set Ordner = Nothing

    Set Dateien = Nothing

    Set FSO = Nothing

End Sub


Geschrieben
Original geschrieben von Schnippterin

Hier mein Beispiel-Code:




Sub Main()

    call DAP

End Sub



Private Sub DAP()

    Dim FSO As FileSystemObject

    Dim Datei As File

    Dim Dateien As Files

    Dim Ordner As Folder

    Dim sDateiName As String

    Dim sPfad As String

    Dim DateiDatum As Date



    DateiDatum = DateAdd("D", lALTER, Format(Now, "dd.mm.yyyy"))

    sPfad = App.Path

    Set FSO = New FileSystemObject

    Set Ordner = FSO.GetFolder(sPfad)

    Set Dateien = Ordner.Files


    For Each Datei In Dateien

        sDateiName = sPfad + "\" + Datei.Name

        If UCase(FSO.GetExtensionName(sDateiName)) = "TXT" Then

            If Format(FSO.GetFile(sDateiName).DateCreated, "dd.mm.yyyy") <  DateiDatum Then

                If Datei.Attributes And ReadOnly = ReadOnly Then

                    Datei.Attributes = Datei.Attributes And Not ReadOnly

                End If

                FSO.DeleteFile (sDateiName)

            End If

        End If

    Next


    Set Ordner = Nothing

    Set Dateien = Nothing

    Set FSO = Nothing

End Sub


dafür brauch man wieder das fso. ich bin der meinung man sollte sich auch in pseudohochsprachen wie visual basic an konventionen halten:

http://www-mmt.inf.tu-dresden.de/Docs/iis3/ASP_Docs/ref/vbs/vbscript/1.htm

afaik gibt's da direkt welche von ***, wobei die gut versteckt sind ;-)

Geschrieben

Mal wieder ein konstruktiver Beitrag:

@nerd:

- Jemand, der 2 Prozeduren nutzt von der eine nichts anderes macht als die zweite aufzurufen, sollte nicht auf Konventionen pochen.

- Dein Script berücksichtigt nicht das Dateien auch mal Schreibschutz genießen können.

- Flaming is a no-no

@Schnippterin:

Gute Arbeit. :)

Anregung meinerseits: Wenn man eh alle Dateien löschen will (auch die inkl. Schreibschutz), kannst du der Funktion DeleteFile auch den zweiten Parameter [force] = true übergeben. Dann wird er einfach ignoriert, die Datei gelöscht.

(Spart das Atrribut entfernen :D)

Eine zusätzlich Möglichkeit zum Aussortieren der alten Dateien wäre auch

(Now - DeleteFile.DateLastModified) > DeleteTimeSpan

als zu prüfende Bedingung. Evtl. können CreateDate & DateLastModified ja auch unterschieedlich sein.

Geschrieben

@nerd:

- Jemand, der 2 Prozeduren nutzt von der eine nichts anderes macht als die zweite aufzurufen, sollte nicht auf Konventionen pochen.

- Dein Script berücksichtigt nicht das Dateien auch mal Schreibschutz genießen können.

- Flaming is a no-no

- schau dir die beiden funktionen nochmal an. denk über sie nach. schau sie dir nochmal an, weil du sie nicht verstanden hast. dann poste deine antwort erneut.

- lies die anforderung. denk über sie nach. lies die anforderung nochmal weil du sie nicht verstanden hast. dann poste auch deine antwort erneut.

vb hat afaik eine 1,5 mb runtime. da braucht man kein großes fso um so triviale probleme zu lösen. programme zu schreiben ist eine sache (wer das nicht kann versteht nicht was er eigentlich tut), eine ganz andere ist es sich an konventionen zu halten. (fehler durch eine klare struktur vermeiden, sourcen übersichtlich für sich selbst und andere leute halten, spätere änderungen an das konzept anpassen, ...)

ich bin ernsthaft der meinung leute müssen wenigstens die ansätze vom codieren begreifen um diesen job machen zu dürfen. es geht hier um elementare dinge die scheinbar ein wenig talent voraussetzen. würde ein kochlehrling fragen: wie koche ich wasser hätte er seinen job verfehlt. und wenn er das fragt und trotzdem in einer firma seine lehre machen darf. dann sollte er den topf nicht zu den tassen stellen. sonst kann der chefkoch das nächstemal seinen topf nicht finden.

ich programmiere schon ein paar jahre und weiß relativ genau wie die vb-gemeinde aussieht. das malen nach zahlen nervt mich ziemlich, aber wenn schon pfusch, dann wenigstens übersichtlich.

fyi. vb ist nicht nur wegen der beschränkten möglichkeiten (pseudo oop) schlecht, sondern auch wegen der masse an schlechten vb-entwicklern ;-)

Geschrieben

'vorher bitte die Microsoft Scripting Runtime über Menü Projekt/Verweise... einbinden

'diese Version ist nun getestet (was jeder Entwickler immer tun sollte!)


Sub Main()

    Dim iTage As Integer

    'wieviele Tage die Datei alt sein muss

    iTage = 2

    LoescheDateien iTage

End Sub



Private Sub LoescheDateien(ByVal Tage As Integer)

    'Diese Routine löscht alle Text-Dateien die sich

    'im aktuellen Programmverzeichnis befinden und älter

    'als x Tage sind

    'Parameter: Tage    wieviele Tage die Datei alt sein muss


    Dim FSO As Object

    Dim Datei As File

    Dim Dateien As Files

    Dim Ordner As Folder

    Dim sDateiName As String

    Dim sPfad As String

    Dim DateiDatum As Date


    Set FSO = CreateObject("Scripting.FileSystemObject")

    'zum aktuellen Datum Tage addieren

    DateiDatum = DateAdd("D", -Tage, Format(Now, "dd.mm.yyyy"))

    sPfad = App.Path

    'Ordner festlegen

    Set Ordner = FSO.GetFolder(sPfad)

    Set Dateien = Ordner.Files

    'Pfad ohne Backslash am Ende formatieren

    If Right(sPfad, 1) = "\" Then sPfad = Left(sPfad, Len(sPfad) - 1)

    'Dateien im aktuellen Programmverzeichnis durchlaufen

    For Each Datei In Dateien

        'Dateipfad zusammensetzen

        sDateiName = sPfad + "\" + Datei.Name

        'nach Text-Dateien filtern

        If UCase(FSO.GetExtensionName(sDateiName)) = "TXT" Then

            'Dateien älter als Tage löschen

            If DateDiff("d", FileDateTime(sDateiName), Now) > Tage Then

                'löschen erzwingen

                FSO.DeleteFile sDateiName, True

            End If

        End If

    Next

    'Objekte zerstören

    Set Ordner = Nothing

    Set Dateien = Nothing

    Set FSO = Nothing

End Sub

@Nerd: *lol* alle Dateien die jünger als 2 Tage oder 2 Tage alt sind werden bei Dir gelöscht...(Anforderung lesen, darüber nachdenken, Anforderung nochmal lesen weil Du sie nicht verstanden hast, dann darfst Du wieder posten :confused: ) buggy-boy :marine

Private Function proofDate2(ByRef strFilename As String, ByVal dCurrentDate As Date) As Boolean

 '// tag von heute + 2 - prüfdatum

 If Format((DateAdd("D", 2, dCurrentDate) - FileDateTime(strFilename)), "D") < KILLDAYS Then

   proofDate2 = True

 Else

   proofDate2 = False

 End If

End Function

Geschrieben
[color=darkblue]Sub[/color] Main

    [color=darkblue]Dim[/color] iTage [color=darkblue]As Integer[/color]

    [color=#9090C0]'wieviele Tage die Datei alt sein muss[/color]

    iTage = 2

    LoescheDateien iTage

[color=darkblue]End[/color] [color=darkblue]Sub[/color]
MS Scripting Runtime ist nicht erforderlich:
[color=darkblue]Private[/color] [color=darkblue]Sub[/color] LoescheDateien[b]([/b][color=darkblue]ByVal[/color] Tage [color=darkblue]As Integer[/color][b])[/b]

    [color=#9090C0]'Diese Routine löscht alle Text-Dateien die sich[/color]

    [color=#9090C0]'im aktuellen Programmverzeichnis befinden und älter[/color]

    [color=#9090C0]'als x Tage sind[/color]

    [color=#9090C0]'Parameter: Tage    wieviele Tage die Datei alt sein muss[/color]


    [color=darkblue]Const[/color] attrAllFiles = vbNormal Or vbArchive Or vbHidden Or vbReadOnly Or vbSystem

    [color=darkblue]Dim[/color] Datei [color=darkblue]As String[/color]

    [color=darkblue]Dim[/color] DateiDatum [color=darkblue]As Date[/color]


    [color=#9090C0]'zum aktuellen Datum Tage addieren[/color]

    DateiDatum = [color=darkblue]Now[/color] - Tage

    [color=#9090C0]'Dateien im aktuellen Programmverzeichnis durchlaufen[/color]

    Datei = [color=darkblue]Dir[/color][b]([/b]App.Path & [color=blue]"\*.txt"[/color], attrAllFiles[b])[/b]     [color=#9090C0]' Retrieve the first entry.[/color]

    [color=darkblue]Do[/color] [color=darkblue]While[/color] Datei <> [color=blue]""[/color]   [color=#9090C0]' Start the [color=darkblue]loop[/color].[/color]

      [color=darkblue]If[/color] FileDateTime[b]([/b]Datei[b])[/b] < DateiDatum [color=darkblue]Then[/color]

        SetAttr Datei, GetAttr[b]([/b]Datei[b])[/b] And Not vbReadOnly

        Kill Datei

      [color=darkblue]End[/color] [color=darkblue]If[/color]

      Datei = [color=darkblue]Dir[/color]

    [color=darkblue]Loop[/color]

[color=darkblue]End[/color] [color=darkblue]Sub[/color]

Aber wenn es denn unbedingt mit MS Scripting Runtime sein soll:
[color=darkblue]Private[/color] [color=darkblue]Sub[/color] LoescheDateien[b]([/b][color=darkblue]ByVal[/color] Tage [color=darkblue]As Integer[/color][b])[/b]

    [color=#9090C0]'Diese Routine löscht alle Text-Dateien die sich[/color]

    [color=#9090C0]'im aktuellen Programmverzeichnis befinden und älter[/color]

    [color=#9090C0]'als x Tage sind[/color]

    [color=#9090C0]'Parameter: Tage    wieviele Tage die Datei alt sein muss[/color]


    [color=darkblue]Dim[/color] FSO [color=darkblue]As New FileSystemObject[/color]

    [color=darkblue]Dim[/color] Datei [color=darkblue]As File[/color]

    [color=darkblue]Dim[/color] DateiDatum [color=darkblue]As Date[/color]


    [color=#9090C0]'zum aktuellen Datum Tage addieren[/color]

    DateiDatum = [color=darkblue]Now[/color] - Tage

    [color=#9090C0]'Dateien im aktuellen Programmverzeichnis durchlaufen[/color]

    [color=darkblue]For[/color] [color=darkblue]Each[/color] Datei In FSO.GetFolder[b]([/b]App.Path[b])[/b].Files

      [color=darkblue]With[/color] Datei

        [color=darkblue]If[/color] .Name Like [color=blue]"*.txt"[/color] [color=darkblue]Then[/color]  [color=#9090C0]'-> 0ption Compare Text![/color]

          [color=darkblue]If[/color] .DateLastModified < DateiDatum [color=darkblue]Then[/color] .Delete [color=darkblue]True[/color]

        [color=darkblue]End[/color] [color=darkblue]If[/color]

      [color=darkblue]End[/color] [color=darkblue]With[/color]

    [color=darkblue]Next[/color]

    [color=#9090C0]'Lokale Objekte werden automatisch zerstört ...[/color]

[color=darkblue]End[/color] [color=darkblue]Sub[/color]

Falls MS Scripting Runtime nicht auch anderweitig verwendet wird, würde ich hier darauf verzichten.

Geschrieben

@Schnippterin

>'vorher bitte die Microsoft Scripting Runtime über Menü Projekt/Verweise...

>einbinden diese Version ist nun getestet (was jeder Entwickler immer tun sollte!)

es ging um einen vorschlag zur lösung des problems nicht darum ein projekt für jemanden zu schreiben. du hast dir richtig mühe bei deinen sourcen gegeben, dafür kannst du ja fast geld verlangen... :D

----

@Stefan Triess

>DateiDatum = Now - Tage

vb ist an der stelle relativ clever :beagolisc

>Datei = Dir(App.Path & "\*.txt", attrAllFiles) ' Retrieve the first entry.

an der stelle aber nicht :rolleyes:

Dein Kommentar

Du kannst jetzt schreiben und Dich später registrieren. Wenn Du ein Konto hast, melde Dich jetzt an, um unter Deinem Benutzernamen zu schreiben.

Gast
Auf dieses Thema antworten...

×   Du hast formatierten Text eingefügt.   Formatierung wiederherstellen

  Nur 75 Emojis sind erlaubt.

×   Dein Link wurde automatisch eingebettet.   Einbetten rückgängig machen und als Link darstellen

×   Dein vorheriger Inhalt wurde wiederhergestellt.   Editor leeren

×   Du kannst Bilder nicht direkt einfügen. Lade Bilder hoch oder lade sie von einer URL.

Fachinformatiker.de, 2024 by SE Internet Services

fidelogo_small.png

Schicke uns eine Nachricht!

Fachinformatiker.de ist die größte IT-Community
rund um Ausbildung, Job, Weiterbildung für IT-Fachkräfte.

Fachinformatiker.de App

Download on the App Store
Get it on Google Play

Kontakt

Hier werben?
Oder sende eine E-Mail an

Social media u. feeds

Jobboard für Fachinformatiker und IT-Fachkräfte

×
×
  • Neu erstellen...