Ordner durchsuchen und namen in xml Datei schreiben
Wie mich Biber gebeten hat mache ich nun mit meinem Proplemchen eine neue Frage auf.
Orginal habe ich meine Frage hier eingebaut gehabt:
https://www.administrator.de/?content=135525
also mit hilfe einiger Mitglieder des forums habe ich folgenden Code mir zusammengebastelt und jetzt auch mit Kommentaren versehen:
Aber leider klappt es nicht ganz wie ich mir erhofft habe
Als erstes gibt er einen Fehler aus auf Zeile 10: Objekt erforderlich
Und dann hab ich es auch nicht hinbekommen, das er schaut nach Dateien die älter sind und diese dann löscht.
Ich hoffe, dass mir da einer im forum weiter helfen kann.
Danke
LG: Andy
Orginal habe ich meine Frage hier eingebaut gehabt:
https://www.administrator.de/?content=135525
also mit hilfe einiger Mitglieder des forums habe ich folgenden Code mir zusammengebastelt und jetzt auch mit Kommentaren versehen:
Aber leider klappt es nicht ganz wie ich mir erhofft habe
Als erstes gibt er einen Fehler aus auf Zeile 10: Objekt erforderlich
Und dann hab ich es auch nicht hinbekommen, das er schaut nach Dateien die älter sind und diese dann löscht.
Ich hoffe, dass mir da einer im forum weiter helfen kann.
Danke
LG: Andy
Option Explicit
' Script durchjsucht Subfolders eines angegebenen Hauptfolders
' Es wird festgestellt ob eine Mindestanzahl von Dateien in einem Subfolder ueberschritten wird
' Wenn ja, dann werden bestimmte Zeilen in eine vordifinierte XML Datei geschrieben.
' vorher wird geprueft ob Dateien mit einer Bestimmten Endung aelter als xx tage sind und diese Geloescht
' VARIABLEN DEFINIEREN
Dim fsoA, tfA, cnt, folderspec, tf, minimumCount, ZielXML, MainFolder, CheckMediaType, MediaTypeAlter
' mehr als x Dateien muessen vorhanden sein um den Folder zu beruecksichtigen
Set minimumCount = 1
'ZielXML Datei festlegen
Set ZielXML = "C:\Users\Moderation\AppData\Roaming\radio42\ProppFrexx ONAIR\3.0\scripts\NewsDispatcher.pfs"
' Hauptverzeichnis das nach unterordnern durchsucht wird
Set MainFolder = "G:\Eigene Musik\000_Redaktion"
' Welche Dateiendung soll beruecksichtigt werden fuer loeschung?
Set CheckMediaType = "mp3"
' Wie lange bleiben MediaType Dateien im Ordner?
Set MediaTypeAlter = 3
' Sub durchsucht MainFolder
Sub ShowFolderList(folderspec, tf)
Dim fs, f, folder, folderList, s
Set fs = CreateObject("Scripting.FileSystemObject")
Set f = fs.GetFolder(folderspec)
Set folderList = f.SubFolders
' Hier beginnt die Suche
For Each folder in folderList
' 1 - Pruefe on Dateien mit vordefinierter Dateiendung aelter ist als x Tage und loesche Diese
' Fehlt noch ...... Delete CheckMediaType aelter als x Tage
' 2 - Jetzt wird geprueft welche Ordner in die XML Datei kommen
If folder.Files.Count > minimumCount Then
'Bestimmte Folders nicht beachten
Select Case f1.name
Case "Bauernregeln":
Case "blickwinkel":
'inix machen
Case "Jahreszeiten und Feste Redaktion":
'inix machen
Case "news-lib-sounds":
'inix machen
Case "regional-news-lib":
'inix machen
Case "wetter":
'inix machen
Case Else
' Jetzt gehts los - Ordner die nicht den namen der obigen haben werden
' In die XML Datei geschrieben
tf.WriteLine(" <line>")
tf.WriteLine(" <mode>Execute</mode>")
tf.WriteLine(" <entry>" & folder.name & "</entry>")
tf.WriteLine(" <count>3</count>")
tf.WriteLine(" <options>3</options>")
tf.WriteLine(" </line>")
s = s & folder.name
s = s & vbCrLf
End Select
End If
Next
' Zu Pruefzwecken eine Meldung ausgeben
MsgBox s
End Sub
Set fsoA = CreateObject("Scripting.FileSystemObject")
Set tfA = fsoA.CreateTextFile(ZielXML, True)
' Inhalte werden in Ziel XML geschrieben
tfA.WriteLine("<?xml version='1.0' encoding='utf-8'?>")
tfA.WriteLine("<script version='1'>")
tfA.WriteLine(" <title>NewsDispatcher</title>")
tfA.WriteLine(" <creator>ProppFrexx ONAIR</creator>")
tfA.WriteLine(" <date>2011-01-03T15:31:58+01:00</date>")
tfA.WriteLine(" <settings>")
tfA.WriteLine(" <mode>Random</mode>")
tfA.WriteLine(" <loopScriptLine>0</loopScriptLine>")
tfA.WriteLine(" <reloadMediaLibrary />")
tfA.WriteLine(" <asyncReloading>true</asyncReloading>")
tfA.WriteLine(" <initialTrack />")
tfA.WriteLine(" <archiveFilename />")
tfA.WriteLine(" <additionalSongHistoryFilename />")
tfA.WriteLine(" <maxHistory>0</maxHistory>")
tfA.WriteLine(" <clearHistoryAtReload>true</clearHistoryAtReload>")
tfA.WriteLine(" <jingleMediaLibrary />")
tfA.WriteLine(" <jingleFrequencyFrom>0</jingleFrequencyFrom>")
tfA.WriteLine(" <jingleFrequencyTo>0</jingleFrequencyTo>")
tfA.WriteLine(" <jingleMode>Random</jingleMode>")
tfA.WriteLine(" <jingleCount>1</jingleCount>")
tfA.WriteLine(" <advertMediaLibrary />")
tfA.WriteLine(" <advertFrequencyFrom>0</advertFrequencyFrom>")
tfA.WriteLine(" <advertFrequencyTo>0</advertFrequencyTo>")
tfA.WriteLine(" <advertMode>Random</advertMode>")
tfA.WriteLine(" <advertCount>1</advertCount>")
tfA.WriteLine(" </settings>")
tfA.WriteLine(" <scriptLines>")
' Aufruf der Subroutine
ShowFolderList MainFolder, tfA
' Abschluszeilen eintragen und Datei schliessen
tfA.WriteLine(" </scriptLines>")
tfA.WriteLine(" <fixTimeElements />")
tfA.WriteLine("</script>")
tfA.Close
Bitte markiere auch die Kommentare, die zur Lösung des Beitrags beigetragen haben
Content-ID: 158112
Url: https://administrator.de/contentid/158112
Ausgedruckt am: 29.11.2024 um 18:11 Uhr
11 Kommentare
Neuester Kommentar
Hi Duswald,
jetzt zu deinem Problem in Zeile 10:
Du versuchst einer Variablen mit Hilfe des Schlüsselwortes "Set" ein Objekt zuzuweisen, dass keines ist.
Da VBS keine expliziten Typzuweisungen bei Variablen voraussetzt (kann man aber trotzdem machen, z.B. 'Dim intTest as Integer', aber das führt hier zu weit ...), kann man einer Variable praktisch alles zuweisen. das Schlüsselwort Set dient dazu, eine Variable mit einem Objekt zu verknüpfen wie z.B. bei einem Dateisystemobjekt: 'Set objFSO = GetObject("Scripting.FileSystemObject").
Willst du der Variable dagegen einen primitiven Datentyp wie in deinem Fall Integer zuweise, lass das 'Set' einfach weg: 'minCounter = 1'. Genau so verhält es sich auch mit Fließkommavariablen oder Strings.
Siehe auch:
http://de.wikipedia.org/wiki/Primitive_Datentypen#Elementare_Datentypen
http://de.wikipedia.org/wiki/Objekt_(Programmierung)
http://de.wikipedia.org/wiki/Deklaration_(Programmierung)
LG Martin
jetzt zu deinem Problem in Zeile 10:
Du versuchst einer Variablen mit Hilfe des Schlüsselwortes "Set" ein Objekt zuzuweisen, dass keines ist.
Da VBS keine expliziten Typzuweisungen bei Variablen voraussetzt (kann man aber trotzdem machen, z.B. 'Dim intTest as Integer', aber das führt hier zu weit ...), kann man einer Variable praktisch alles zuweisen. das Schlüsselwort Set dient dazu, eine Variable mit einem Objekt zu verknüpfen wie z.B. bei einem Dateisystemobjekt: 'Set objFSO = GetObject("Scripting.FileSystemObject").
Willst du der Variable dagegen einen primitiven Datentyp wie in deinem Fall Integer zuweise, lass das 'Set' einfach weg: 'minCounter = 1'. Genau so verhält es sich auch mit Fließkommavariablen oder Strings.
Siehe auch:
http://de.wikipedia.org/wiki/Primitive_Datentypen#Elementare_Datentypen
http://de.wikipedia.org/wiki/Objekt_(Programmierung)
http://de.wikipedia.org/wiki/Deklaration_(Programmierung)
LG Martin
Hallo Andy!
Zunächst mal alle Set's von Codezeile 10 - 18 entfernen
Den Grund hat KingNothing ja schon erklärt. Allerdings sind in VBS keine Typ-Zuweisungen alla As Integer, As Date.... zulässig
Gruß Dieter
Zunächst mal alle Set's von Codezeile 10 - 18 entfernen
Den Grund hat KingNothing ja schon erklärt. Allerdings sind in VBS keine Typ-Zuweisungen alla As Integer, As Date.... zulässig
Gruß Dieter
Hallo Andy!
In etwa so:
Dir ist aber schon klar, dass Du nur die 1. SubFolder-Ebene dursuchst und nicht alle darunter liegenden SubFolder's?
Gruß Dieter
In etwa so:
CheckMediaType = "mp3"
MediaTypeAlter = 3 'In Tagen
'...........
For Each Folder In folderList
For Each File In Folder.Files
If LCase(fs.GetExtensionName(File.Name)) = LCase(CheckMediaType) Then
'Test Datei-Datum kleiner (Jetzt - Anzahl Tage)
If File.DateLastModified < DateAdd("d", -MediaTypeAlter, Now) Then File.Delete 'Änderungsdatum
'oder
If File.DateCreated < DateAdd("d", -MediaTypeAlter, Now) Then File.Delete 'Erstellungsdatum
End If
Next
'...........
Next
Dir ist aber schon klar, dass Du nur die 1. SubFolder-Ebene dursuchst und nicht alle darunter liegenden SubFolder's?
Gruß Dieter
Hi,
@Dieter: Ja, ich war mir nicht mehr sicher, weil ich das auch schon mit expliziter Typ-Zuweisung gesehen habe. Bin mir aber nicht mehr sicher, ob das VBS, VBA oder doch VB6 war.
@andy: Die Lösung für dein Problem ist Rekursion. Was das ist, steht hier: http://de.wikipedia.org/wiki/Rekursive_Programmierung
Im Klartext: In deiner Funktion durchläufst du ja alle Ordner. Ruf einfach für jeden Ordner die Funktion in sich selber nochmal auf, dann sollte es klappen.
LG
Martin
@Dieter: Ja, ich war mir nicht mehr sicher, weil ich das auch schon mit expliziter Typ-Zuweisung gesehen habe. Bin mir aber nicht mehr sicher, ob das VBS, VBA oder doch VB6 war.
@andy: Die Lösung für dein Problem ist Rekursion. Was das ist, steht hier: http://de.wikipedia.org/wiki/Rekursive_Programmierung
Im Klartext: In deiner Funktion durchläufst du ja alle Ordner. Ruf einfach für jeden Ordner die Funktion in sich selber nochmal auf, dann sollte es klappen.
LG
Martin
Hallo Andy!
Das wäre mein Lösungsvorschlag zu dem Ganzen:
Gruß Dieter
[edit] Codezeile 49 geändert [/edit]
Das wäre mein Lösungsvorschlag zu dem Ganzen:
Option Explicit
Const FileCountMin = 1
Const MediaTypeAlter = 2 'In Tagen
Const CheckMediaType = "mp3"
Const StartFolder = "G:\Eigene Musik\000_Redaktion"
Const XmlFilePath = "C:\Users\Moderation\AppData\Roaming\radio42\ProppFrexx ONAIR\3.0\scripts\NewsDispatcher.pfs"
Const NoFolders = "Bauernregeln;Blickwinkel;Jahreszeiten und Feste Redaktion;News-Lib-Sounds;Regional-News-Lib;Wetter"
Const TextCompare = 1 'Dictionary Compare Text
Dim Fso, File, XmlFile, Folder, SubFolder, IgnoreFolders, FolderList
'Main Begin
Set FolderList = CreateObject("Scripting.Dictionary")
Set Fso = CreateObject("Scripting.FileSystemObject")
FolderList.CompareMode = TextCompare
IgnoreFolders = Split(NoFolders, ";")
'NoFolders registrieren (Key, Wert (Wert unwichtig, geprüft wird auf Key.Exists)
For Each Folder In IgnoreFolders
FolderList.Add Folder, False
Next
Call OpenXmlFile(XmlFilePath)
For Each SubFolder In Fso.GetFolder(StartFolder).SubFolders
If Not FolderList.Exists(SubFolder.Name) Then
For Each File In SubFolder.Files
If LCase(Fso.GetExtensionName(File.Name)) = LCase(CheckMediaType) Then
If File.DateCreated < DateAdd("d", -MediaTypeAlter, Now) Then File.Delete 'Erstellungsdatum
End If
Next
If SubFolder.Files.Count > FileCountMin Then Call WriteXmlFile(SubFolder.Name)
End If
Next
Call CloseXmlFile
MsgBox "Fertig!", vbInformation, "Ordnersuche..."
'Main End
Sub OpenXmlFile(ByRef Path)
Set XmlFile = Fso.CreateTextFile(Path, True)
With XmlFile
.WriteLine "<?xml version='1.0' encoding='utf-8'?>"
.WriteLine "<script version='1'>"
.WriteLine vbTab & "<title>NewsDispatcher</title>"
.WriteLine vbTab & "<creator>ProppFrexx ONAIR</creator>"
.WriteLine vbTab & "<date>2011-01-03T15:31:58+01:00</date>"
.WriteLine vbTab & "<settings>"
.WriteLine vbTab & vbTab & "<mode>Random</mode>"
.WriteLine vbTab & vbTab & "<loopScriptLine>0</loopScriptLine>"
.WriteLine vbTab & vbTab & "<reloadMediaLibrary />"
.WriteLine vbTab & vbTab & "<asyncReloading>true</asyncReloading>"
.WriteLine vbTab & vbTab & "<initialTrack />"
.WriteLine vbTab & vbTab & "<archiveFilename />"
.WriteLine vbTab & vbTab & "<additionalSongHistoryFilename />"
.WriteLine vbTab & vbTab & "<maxHistory>0</maxHistory>"
.WriteLine vbTab & vbTab & "<clearHistoryAtReload>true</clearHistoryAtReload>"
.WriteLine vbTab & vbTab & "<jingleMediaLibrary />"
.WriteLine vbTab & vbTab & "<jingleFrequencyFrom>0</jingleFrequencyFrom>"
.WriteLine vbTab & vbTab & "<jingleFrequencyTo>0</jingleFrequencyTo>"
.WriteLine vbTab & vbTab & "<jingleMode>Random</jingleMode>"
.WriteLine vbTab & vbTab & "<jingleCount>1</jingleCount>"
.WriteLine vbTab & vbTab & "<advertMediaLibrary />"
.WriteLine vbTab & vbTab & "<advertFrequencyFrom>0</advertFrequencyFrom>"
.WriteLine vbTab & vbTab & "<advertFrequencyTo>0</advertFrequencyTo>"
.WriteLine vbTab & vbTab & "<advertMode>Random</advertMode>"
.WriteLine vbTab & vbTab & "<advertCount>1</advertCount>"
.WriteLine vbTab & "</settings>"
.WriteLine vbTab & "<scriptLines>"
End With
End Sub
Sub WriteXmlFile(ByRef FolderName)
With XmlFile
.WriteLine vbTab & vbTab & "<line>"
.WriteLine vbTab & vbTab & vbTab & "<mode>Execute</mode>"
.WriteLine vbTab & vbTab & vbTab & "<entry>" & FolderName & "</entry>"
.WriteLine vbTab & vbTab & vbTab & "<count>3</count>"
.WriteLine vbTab & vbTab & vbTab & "<options>3</options>"
.WriteLine vbTab & vbTab & "</line>"
End With
End Sub
Sub CloseXmlFile()
With XmlFile
.WriteLine vbTab & "<\scriptLines>"
.WriteLine vbTab & "<fixTimeElements />"
.WriteLine "</script>"
.Close
End With
End Sub
Gruß Dieter
[edit] Codezeile 49 geändert [/edit]
Hallo Andy!
Noch ein Hinweis zu Codezeile 35:
Aktuell werden die Anzahl Tage inklusive Zeit gerechnet (08.01.2011 17:28:26).
Wenn aber nur das Datum mit Tage gerechnet werden soll, dann die Codezeile 35 ändern in:
oder
Gruß Dieter
PS. Und das grüne Gelöst-Häkchen nicht vergessen
Zitat von @Duswald:
danke euch für diese Hilfe -Klappt supi und hilft uns nun sehr bei der Automation unserer Nachrichten Redaktion
Freut michdanke euch für diese Hilfe -Klappt supi und hilft uns nun sehr bei der Automation unserer Nachrichten Redaktion
Lauter Profis hier ich merk schon
Bin auch noch AnfängerNoch ein Hinweis zu Codezeile 35:
Aktuell werden die Anzahl Tage inklusive Zeit gerechnet (08.01.2011 17:28:26).
Wenn aber nur das Datum mit Tage gerechnet werden soll, dann die Codezeile 35 ändern in:
If DateValue(File.DateCreated) < DateValue(DateAdd("d", -MediaTypeAlter, Now)) Then File.Delete |
If DateValue(File.DateCreated) < DateAdd("d", -MediaTypeAlter, Date) Then File.Delete |
Gruß Dieter
PS. Und das grüne Gelöst-Häkchen nicht vergessen
Hallo Andy!
Also, wenn das Haltbarkeitsdatum im Dateinamen steht z.B. NachrichtDatei-08012011.mp3, dann würde ich es schematisch in etwa so machen:
Gruß Dieter
Also, wenn das Haltbarkeitsdatum im Dateinamen steht z.B. NachrichtDatei-08012011.mp3, dann würde ich es schematisch in etwa so machen:
If (File.Attribute And Archiv-Bit) <> 0 Then
If DateiNamenDatum <= Aktuelles Datum Then Archiv-Bit löschen 'Inkl. Dateien, die zuvor noch nicht erfasst wurden
Else
If DateiNamenDatum < (Aktuelles Datum - Anzahl Tage) Then Datei löschen
End If
Gruß Dieter