VB Programmierung

[ygeli]

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!!!!!!!!

Danke!

[hide]

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.

[PeliWeli]

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!

[eXoCooLd]

kannst auch einfach mit Kill "pfad\datei" machen

[ygeli]

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!!!

[Nerd]

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...

[Schnippterin]

tuffiger Code, Nerd *lol*

hast du vielleicht ein pic von dir????

[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

[Nerd]

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 ;-)

[Honkytonk]

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 )

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.

[Nerd]

@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 ;-)

[Schnippterin]

'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

[Stefan Triess]

[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.

[Nerd]

@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...

----

@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

[Schnippterin]

@Nerd: Ich glaube ich werde Millionär mit diesem Mega-Programm :marine

[Nerd]

@Schnippterin: cool, dann brauch ich dir kein geld mehr leihen...

[-roTekuGeL-]

Original geschrieben von Nerd

@Schnippterin: cool, dann brauch ich dir kein geld mehr leihen...

*hust* OT!!! :floet: