knuefi
Mar 19, 2016, updated at 18:29:38 (UTC)
view2466
view18
0
Goto Top

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

GermansolvedQuestionBatch, ShellDevelopment
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]
comment-contentCommentShareShare
Share on Facebook Share on Twitter Share on Reddit Share on Linkedin

Content-Key: 299580

Url: https://administrator.de/contentid/299580

Printed on: April 24, 2024 at 23:04 o'clock

18 Comments
Latest comment
Goto Top
Member: beidermachtvongreyscull
beidermachtvongreyscull Mar 19, 2016 at 17:44:05 (UTC)
Goto Top
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.
Member: Knuefi
Knuefi Mar 19, 2016 at 18:58:49 (UTC)
Goto Top
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
Member: Biber
Biber Mar 19, 2016 at 23:39:29 (UTC)
Goto Top
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
heart1
Member: beidermachtvongreyscull
beidermachtvongreyscull Mar 20, 2016 updated at 09:30:30 (UTC)
Goto Top
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
heart1
Member: Knuefi
Knuefi Mar 21, 2016 at 15:21:16 (UTC)
Goto Top
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
Member: beidermachtvongreyscull
beidermachtvongreyscull Mar 21, 2016 updated at 15:37:06 (UTC)
Goto Top
Du brauchst nicht danken. Ich helfe gerne.
Bitte poste Dein Script nochmal vollständig (bitte in den CODE-Tags - das erleichtert das Lesen.).
Member: Biber
Biber Mar 21, 2016 at 15:46:33 (UTC)
Goto Top
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
heart1
Member: Knuefi
Knuefi Mar 21, 2016 updated at 17:54:06 (UTC)
Goto Top
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.
Member: colinardo
colinardo Mar 21, 2016 updated at 20:27:34 (UTC)
Goto Top
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 face-smile

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.
heart1
Member: Knuefi
Knuefi Mar 22, 2016 at 15:43:39 (UTC)
Goto Top
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
Member: colinardo
colinardo Mar 22, 2016 updated at 17:11:33 (UTC)
Goto Top
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
Member: Biber
Biber Mar 22, 2016 updated at 16:10:49 (UTC)
Goto Top
[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]
Member: colinardo
colinardo Mar 22, 2016 updated at 16:27:20 (UTC)
Goto Top
So wird dieser Thread
a) nie fertig
Bei Minions wird doch sowieso nie was fertig face-big-smile
Member: Knuefi
Knuefi Mar 22, 2016 at 17:05:32 (UTC)
Goto Top
Leider habt ihr beide Recht face-sad, dieser Thread wird nie fertig. Ich bekomme folgende Fehlermeldung
unbenannt
Member: colinardo
colinardo Mar 22, 2016 updated at 17:13:47 (UTC)
Goto Top
Tippfühler ... face-smile. Dachte ein Minion findet den face-big-smile

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

Grüße Uwe
Member: Knuefi
Knuefi Mar 22, 2016 at 17:38:07 (UTC)
Goto Top
Zitat von @colinardo:

Tippfühler ... face-smile. Dachte ein Minion findet den face-big-smile

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?
Member: colinardo
Solution colinardo Mar 22, 2016 updated at 17:49:08 (UTC)
Goto Top
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
heart1
Member: Knuefi
Knuefi Mar 22, 2016 at 18:00:41 (UTC)
Goto Top
Vielen Dank noch mal an alle, ich bewundere eure Geduld face-smile.
@ colinardo: Danke für die ausführliche Erklärung, Top
GermansolvedQuestionBatch, ShellDevelopment
Hotly discussed
gleixnerdCheck of ZFW Firewallgleixnerd - 5 CommentsjstrickerWireguard VPN on UDM Pro behind Fritzbox - Handshake did not completejstricker - 3 Comments