19.03.2016

2765

VBS msgbox meldung nach jeden durchsuchten Ordner und nicht am Schluß

Hallo
da mir immer hier geholfen wurde, wende ich mich mal wieder an Euch. Ich habe ein Script zur Löschung bestimmter Dateien (nach Namen) die über Verknüpfungen in meheren Ordnern gesucht werden.

Const PFAD = "C:Max\test"  
Set fso = CreateObject("Scripting.FileSystemObject")  
Set objShell = CreateObject("Wscript.Shell")  
strFile = Inputbox("Bitte Dateiname zum löschen eingeben")  
IF strFile=FALSE THEN
CreateObject("WScript.Shell").Popup "Abruch,keine Datei gelöscht",4, "Information"  
If (fso.FileExists(PFAD & strFile)) Then
fso.DeleteFile strFile,True
End If
End If
for each myFile in fso.GetFolder(PFAD).Files
If LCase(fso.GetExtensionName(myFile.Name)) = "lnk" then  
target = objShell.CreateShortcut(myFile.Path).TargetPath & "\ "  
If (fso.FileExists(target & "\" & strFile)) Then  
fso.DeleteFile target & "\" & strFile,True  
MsgBox "Fertig, Dateien gelöscht !!"  
else
MsgBox "die Datei gibt es nicht !!"  
End If
End If
Next

Problem 1: Die Meldung per msgbox "die Datei gibt es nicht" sollte erst nach Duchsuchung aller Ordner inklusive Unterordner erscheinen, dieses geschieht aber bei jeden Ordner der durchsucht wird und diese Datei nicht beinhaltet. Zudem kommt die Msgbox Meldung "Fertig, Dateien gelöscht" nach jeder einzelne Löschung, die jeweilige Meldung soll natürlich nur einmalig am Ende kommen.

Problem 2: Im Ordner C:Max\test befinden sich mehre Verknüfungen (unterschiedliche Namen) die zu mehren Ordnern (unterschiedliche Namen) in denen sich zwei Unteordner mit den Namen Foto und Musik befinden, diese sollen auch nach der Datei gesucht und gelöscht werden.

Ich es versucht mit:

for each myFile in fso.GetFolder(PFAD).Files
If LCase(fso.GetExtensionName(myFile.Name)) = "lnk" then  
target = objShell.CreateShortcut(myFile.Path).TargetPath & "\Foto" & "\Musik"  
If (fso.FileExists(target & "\" & strFile)) Then  
fso.DeleteFile target & "\" & strFile,True  

zweiter Versuch:

for each myFile in fso.GetFolder(PFAD).Files
If LCase(fso.GetExtensionName(myFile.Name)) = "lnk" then  
target = objShell.CreateShortcut(myFile.Path).TargetPath & "\*"  
If (fso.FileExists(target & "\" & strFile)) Then  
fso.DeleteFile target & "\" & strFile,True  

beide waren ohne Erfolg, was mache ich falsch?

Gruß
knuefi

[Edit Biber] Codetags, aber die bringen hier nur Zeilennummern. [/Edit]

Bitte markiere auch die Kommentare, die zur Lösung des Beitrags beigetragen haben

Content-ID: 299580

Url: https://administrator.de/forum/vbs-msgbox-meldung-nach-jeden-durchsuchten-ordner-und-nicht-am-schluss-299580.html

Ausgedruckt am: 08.07.2025 um 12:07 Uhr

18 Kommentare

Neuester Kommentar

Problem 1 kannst Du lösen, indem Du den Aufruf der msgbox aus der for/next-Schleife rausnimmst.

Setze Deinen Code bitte in Code-Tags, dann ist er besser lesbar.

Hallo beidermachtvongreyscull,

leider verstehe ich das nicht, ich habe erstmal Versucht nur die Fertig Meldung aus der for next Schleife zu nehmen. So habe ich es probiert:

Const PFAD = "C:Max\test"  
 Set fso = CreateObject("Scripting.FileSystemObject")  
 Set objShell = CreateObject("Wscript.Shell")  
 strFile = Inputbox("Bitte Dateiname zum löschen eingeben")  
 IF strFile=FALSE THEN
 CreateObject("WScript.Shell").Popup "Abruch,keine Datei gelöscht",4, "Information"  
 If (fso.FileExists(PFAD & strFile)) Then
 fso.DeleteFile strFile,True
 End If
 End If
 for each myFile in fso.GetFolder(PFAD).Files
 If LCase(fso.GetExtensionName(myFile.Name)) = "lnk" then  
 target = objShell.CreateShortcut(myFile.Path).TargetPath & "\ "  
 If (fso.FileExists(target & "\" & strFile)) Then  
 fso.DeleteFile target & "\" & strFile,True  
 MsgBox "Fertig, Dateien gelöscht !!"  
 End If
 End If
 MsgBox "Fertig, Dateien gelöscht !!"  
 Next

Leider bekomme ich eine Fehlermeldung

Moin knuefi,

Zitat von @Knuefi:

Hallo beidermachtvongreyscull,

leider verstehe ich das nicht, ich habe erstmal Versucht nur die Fertig Meldung aus der for next Schleife zu nehmen.

Leider kann ich nicht programmieren.
Aber ich glaube, wenn du die MsgBox() aus der For..Next genommen hättest, dann stünde diese Zeile bestimmt unterhalb der Zeile mit dem Wort "Next", oder?

Meinjanur...

Biber

Zitat von @Knuefi:

Hallo beidermachtvongreyscull,

leider verstehe ich das nicht, ich habe erstmal Versucht nur die Fertig Meldung aus der for next Schleife zu nehmen. So habe ich es probiert:

Const PFAD = "C:Max\test"  
>  Set fso = CreateObject("Scripting.FileSystemObject")  
>  Set objShell = CreateObject("Wscript.Shell")  
>  strFile = Inputbox("Bitte Dateiname zum löschen eingeben")  
>  IF strFile=FALSE THEN
>  CreateObject("WScript.Shell").Popup "Abruch,keine Datei gelöscht",4, "Information"  
>  If (fso.FileExists(PFAD & strFile)) Then
>  fso.DeleteFile strFile,True
>  End If
>  End If
>  for each myFile in fso.GetFolder(PFAD).Files

Obige Zeile startet eine for/nex-Schleife für jede Datei! Dies wird erst mit der "next"-Zeile beendet.

>  If LCase(fso.GetExtensionName(myFile.Name)) = "lnk" then  
>  target = objShell.CreateShortcut(myFile.Path).TargetPath & "\ "  
>  If (fso.FileExists(target & "\" & strFile)) Then  
>  fso.DeleteFile target & "\" & strFile,True  
>  MsgBox "Fertig, Dateien gelöscht !!"  

Deswegen wird die obige Zeile bei jeder Datei ausgeführt.

>  End If
>  End If
>  MsgBox "Fertig, Dateien gelöscht !!"  

So auch hier.

>  Next
> 

Leider bekomme ich eine Fehlermeldung

Du musst Dich fragen, was Du ausgeben willst. Wenn Du die Fehlermeldung "Dateien gelöscht" ausgeben willst, wenn Du mindestens eine Datei gelöscht hast, arbeite mit einer Status-Variablen.
Das kann so aussehen:

for each myFile in fso.GetFolder(PFAD).Files
...
 If (fso.FileExists(PFAD & strFile)) Then 
 fso.DeleteFile strFile,True 
numDeleteStatus = 1 
End If
...
next 
...
if numDeleteStatus = 1 Then
MsgBox "Fertig, Dateien gelöscht !!"  
End If

Hallo beidermachtvongreyscull,

mit deiner Hilfe habe ich es nicht nur hin bekommen sondern auch Verstanden. Danke dafür!!. Nun möchte ich beim nicht Löschen einer Datei, eine Abfrage per MsgBox machen und eine Möglichkeit der neu Eingabe geben. Soweit ist es mir klar womit ich die Abfrage mache, aber wie lasse ich das Script bzw. die Inputbox erneut starten. Mit einer Schleife, wie geht das?

else
Abfrage = MsgBox ("die Datei gibt es im Ordner nicht",vbRetryCancel,"Information")
if Abfrage = vbRetry Then

Du brauchst nicht danken. Ich helfe gerne.
Bitte poste Dein Script nochmal vollständig (bitte in den CODE-Tags - das erleichtert das Lesen.).

Moin knuefi,

meinst du nicht, du solltest erst mal mit einem kleinen Notizzettel und einem Werbekuli von der CeBit eine Skizze machen, wie denn der Programmablauf geplant ist?

Du brauchst doch einfach nur oberhalb der Zeile
strfile = Inputbox(...)
noch eine äußere Schleife einfügen:

 Abfrage = vbRetry
do while Abfrage = vbRetry
    strfile = Inputbox(...)
    ' .....(bisheriges Geraffel)  

    Abfrage = MsgBox ("die Datei gibt es im Ordner nicht",vbRetryCancel,"Information")  
loop

Grüße
Biber

Hallo Biber,
erstmal Danke für deine Hilfe. Irgendwie bekomme ich es nicht hin, ich habe es so verstanden:

Const PFAD = "C:Max\test"  
 Set fso = CreateObject("Scripting.FileSystemObject")  
 Set objShell = CreateObject("Wscript.Shell")  
Abfrage = vbRetry
do while Abfrage = vbRetry
 strFile = Inputbox("Bitte Dateiname zum löschen eingeben")  
....
.....
....
....
numDeleteStatus = 1
End If
End If
Next
if numDeleteStatus = 1 Then
MsgBox "Fertig, die Datei wurde gelöscht"  
else
Abfrage= MsgBox ("die Datei gibt es nicht",vbRetryCancel,"Information")  
End IfvbRetryCancel,"Information")  
loop
End If

Leider geht es nicht.

Hallo Knuefi,
ich schau mir das nun schon eine Zeit lang an ... damit das hier mal ein Ende hat und du anscheinend doch noch ziemliche Probleme mit den Grundlagen des Programmierens hast, hier mal ein komplettes kommentiertes Beispiel das all deine Punkte umsetzt.

Was @Biber auch schon angemerkt hat: Mach erst mal eine "vollständige" Skizze deines Vorhabens und erst dann setzt du dich hin und strukturierst das ganze, nicht anders herum.

' Basisordner festlegen  
Const BASEFOLDER = "C:\Max\test"  
' Variablen deklarieren  
Dim arrFoundFiles(),cnt, strFind
' Count-Variable initialisieren diese enthält die Anzahl der gefundenen Dateien  
cnt = 0
' benötigte Objekte erstellen  
Set fso = CreateObject("Scripting.FileSystemObject")  
Set objShell = CreateObject("Wscript.Shell")  

' Schleife für Wiederholungen  
Do While cnt = 0
	' Suchstring abfragen  
	strFind = InputBox("Bitte zu suchenden Dateinamen eingeben:","Dateiname","test.txt")  
	' Wenn User Cancel klickt oder keinen String eingibt abbrechen  
	If strFind = False Or strFind = "" Then Exit Do  
	' Suche im Basisordner mit Suchbegriff starten  
	FindFilesRecursive fso.GetFolder(BASEFOLDER),strFind
	' Wurde keine Datei gefunden, Nachfrage ob erneut gesucht werden soll, ansonsten Abbruch  
	If cnt = 0 Then
		If MsgBox("Die Suche war nicht erfolgreich. Möchten sie die Eingabe wiederholen?",vbYesNo Or vbQuestion) = vbNo Then  
                        ' Springe aus der Schleife  
			Exit Do
		End If
	Else
		' Suche war erfolgreich, zeige die gefundenen Dateien an und frage ob sie gelöscht werden sollen  
		If MsgBox("Die Suche hat folgende Dateien gefunden: " & vbNewLine & vbNewline & Join(arrFoundFiles,vbNewLine) & vbNewLine & vbNewLine & "Möchten sie diese nun löschen?", vbQuestion Or vbYesNo) = vbYes Then  
			' Dateien die gefunden wurden löschen  
			For Each file In arrFoundFiles
				fso.DeleteFile file, True
			Next
		End If
	End If
Loop


'Funktion duchsucht Verzeichnisse rekursiv inkl. 'lnk' Auswertung  
Function FindFilesRecursive(objFolder, strSearch)
	if fso.FileExists(objFolder.Path & "\" & strSearch) Then  
			ReDim Preserve arrFoundFiles(cnt)
			arrFoundFiles(cnt) = objFolder.Path & "\" & strSearch  
			cnt = cnt + 1
		End If
     for each file in objFolder.Files
		If LCase(fso.GetExtensionName(file.Name)) = "lnk" Then  
			FindFilesRecursive fso.GetFolder(objShell.CreateShortcut(file.Path).TargetPath),strSearch
		End If
	Next
	For Each subfolder In objFolder.SubFolders
		FindFilesRecursive subfolder, strSearch
	Next
End Function

Hoffentlich lernst du was draus

Grüße Uwe

p.s. meine dringende Empfehlung sich vielleicht doch erst mal mit den grundlegenden Dingen der Programmierung auseinander zu setzen, anstatt so quer einzusteigen.

Hallo Uwe,

vielen Danke für das perfekt erklärte Script !!!!, nun weiß ich warum die Schleife nicht ging. Dein erstelltes Script ist natürlich noch viel viel viel besser und dieses würde ich gerne nutzen. Wenn ich es richtig verstehe werden alle Verknüpfungen durchsucht, dieses ist aber nicht nötig. Wenn es auf die zwei Verknüpfungen (Foto und Musik) begrenzt werden würde, würde es doch schneller laufen oder?

Problem 2: Im Ordner C:Max\test befinden sich mehre Verknüfungen (unterschiedliche Namen) die zu mehren Ordnern (unterschiedliche Namen) in denen sich zwei Unteordner mit den Namen Foto und Musik befinden, diese sollen auch nach der Datei gesucht und gelöscht werden

Das Skript oben durchsucht alles, d.h. alle Unterordner rekursiv und alle Ordner die durch *.lnk Verknüpft wurden ebenfalls rekursiv. Also tutto completto wie man so schön sagt.

Wenn in deinen LNKs nur deine zwei Ordner durchsucht werden sollen, ändere nur die Funktion des oberen Codes so ab:

Function FindFilesRecursive(objFolder, strSearch)
	if fso.FileExists(objFolder.Path & "\" & strSearch) Then  
			ReDim Preserve arrFoundFiles(cnt)
			arrFoundFiles(cnt) = objFolder.Path & "\" & strSearch  
			cnt = cnt + 1
		End If
     for each file in objFolder.Files
		If LCase(fso.GetExtensionName(file.Name)) = "lnk" Then  
                        strTarget = objShell.CreateShortcut(file.Path).TargetPath
                        For Each f In Array("Foto","Musik")  
                            If fso.FolderExists(strTarget & "\" & f) then  
			        FindFilesRecursive fso.GetFolder(strTarget & "\" & f),strSearch  
                            End if
                        Next
		End If
	Next
	For Each subfolder In objFolder.SubFolders
		FindFilesRecursive subfolder, strSearch
	Next
End Function

- edit - Tippfehler behoben

[OT] @colinardo
In Zeile 14 hast du nach dem Copy&Paste nicht nachgearbeitet....

FindFilesRecursive fso.GetFolder(strTarget & "\Fotos"),strSearch '

-> diese Zeile ~~gibt~~ gab es zweimal, was immer verdächtig ist bei Scriptern, die nicht nach lines per hour bezahlt werden.

So wird dieser Thread
a) nie fertig
b) nie mein Lieblingsbeitrag

aber ich bewundere deine Geduld...

Grüße
Biber
[/OT]

So wird dieser Thread
a) nie fertig

Bei Minions wird doch sowieso nie was fertig

Leider habt ihr beide Recht

, dieser Thread wird nie fertig. Ich bekomme folgende Fehlermeldung

Tippfühler ...

. Dachte ein Minion findet den

Na dann noch viel Erfolg Mister Copy n' Paste ....

Grüße Uwe

Zitat von @colinardo:

Tippfühler ...

. Dachte ein Minion findet den

Ich bin erlich, ich habe den Tippfehler immer noch nicht gefunden. Na ja, ich gelobe Besserung. Ich traue mich gar nicht zu fragen, aber nur so kann ich dazu lernen. Was bedeutet das ?: (strTarget & "\" & f). Das &"\" ist mir klar, aber was bedeutet das & f?

Zitat von @Knuefi:
Ich bin erlich, ich habe den Tippfehler immer noch nicht gefunden. Na ja, ich gelobe Besserung. Ich traue mich gar nicht zu fragen, aber nur so kann ich dazu lernen. Was bedeutet das ?: (strTarget & "\" & f). Das &"\" ist mir klar, aber was bedeutet das & f?

Der Fehler war ein fehlendes & für die Verknüpfung der Variablen in dieser Zeile

fso.FolderExists(strTarget & "\" & f)

Das Konstrukt ist eine einfache ForEach-Schleife die das Array bestehend aus den Strings Foto und Musik durchläuft. In der Variablen f steht dann jeweils entweder Foto oder Musik. Das ist eine Methode um sich mehrfach wiederholenden Codefragmente einzusparen.

strTarget = objShell.CreateShortcut(file.Path).TargetPath
For Each f In Array("Foto","Musik")  
     If fso.FolderExists(strTarget & "\" & f) then  
	  FindFilesRecursive fso.GetFolder(strTarget & "\" & f),strSearch  
     End if
Next