aletri
Jan 06, 2017
view1970
view6
0
Goto Top

Vbscipt zur Ueberprüfung ob Ordner existiert je nach Resultat Ausführung oder nicht

GermanQuestionVB for ApplicationsDevelopment
Guten Morgen

Eigentlich funktioniert dieser Script !
Existiert jedoch der Ordner der Abfrage auf Zeile 04 , wird richtigerweisse der Task nicht ausgeführt
aber die nächsten Abfragen auf Zeilen 38, 71 und 74 werden dann nicht ausgeführt...es geht nicht weiter!!
Der Scipt sollte ungeachtet ob die Ordner existieren oder nicht die nächtsen Abfragen durchführen!?

WScript.Sleep 1000

Set fso = CreateObject("Scripting.FileSystemObject")  
if FSO.Folderexists("C:\Program Files (x86)\Microsoft Games\Microsoft Flight Simulator X\Addon Scenery\Europe\Italy\ATi Strade") = False then  

CfgFilePath = "C:\ProgramData\Microsoft\FSX\Scenery.CFG"  
Dim Record (10000)
ScenTitle = "Title=ATi Strade"  
EntryNumRows = 7
	
Set fs = CreateObject("Scripting.FileSystemObject")   
Set a = fs.OpenTextFile(CfgFilePath, 1, FALSE) 
 

i = 1
Do While Not a.AtEndOfStream 
	aLine = a.ReadLine
	PosTitle=Instr(1, aLine, ScenTitle)
	
	If 	PosTitle <> 0 Then
		StartRow = i-1
		EndRow = StartRow + EntryNumRows - 1
	End If 
	Record(i) = aLine
	i = i+1 
Loop 

a.Close 

Set a = fs.CreateTextFile(CfgFilePath, True)
For n = 1 To i-1 
	If (n < StartRow) or (n > EndRow) then
		a.WriteLine(Record(n)) 
	End If
	
Next

Set fso = CreateObject("Scripting.FileSystemObject")  
if FSO.Folderexists("C:\Program Files (x86)\Microsoft Games\Microsoft Flight Simulator X\Addon Scenery\Europe\Italy\ATI Coste") = False then  

ScenTitle = "Title=ATi Coste"  
EntryNumRows = 7
	
Set fs = CreateObject("Scripting.FileSystemObject")   
Set a = fs.OpenTextFile(CfgFilePath, 1, FALSE) 
 

i = 1
Do While Not a.AtEndOfStream 
	aLine = a.ReadLine
	PosTitle=Instr(1, aLine, ScenTitle)
	
	If 	PosTitle <> 0 Then
		StartRow = i-1
		EndRow = StartRow + EntryNumRows - 1
	End If 
	Record(i) = aLine
	i = i+1 
Loop 

a.Close 

Set a = fs.CreateTextFile(CfgFilePath, True)
For n = 1 To i-1 
	If (n < StartRow) or (n > EndRow) then
		a.WriteLine(Record(n)) 
	End If
	
Next

Set fso = CreateObject("Scripting.FileSystemObject")  
if FSO.Folderexists("C:\zATi\ATicheckfiles") = False then  

Set FSO = CreateObject("Scripting.FileSystemObject")  
 FSO.DeleteFolder("C:\Program Files (x86)\Microsoft Games\Microsoft Flight Simulator X\Scripts")  
 
Set fs = Nothing 

End if 
End if
End if
comment-contentCommentShareShare
Share on Facebook Share on Twitter Share on Reddit Share on Linkedin

Content-Key: 325675

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

Printed on: April 16, 2024 at 10:04 o'clock

6 Comments
Latest comment
Goto Top
Member: UnbekannterNR1
UnbekannterNR1 Jan 06, 2017 at 09:39:06 (UTC)
Goto Top
Ohne es im Detail zu kennen und selber noch Anfänger bin würde ich sagen. Das ein "End if" vom Ende in Zeile 35 muss. Ansonsten steht gesamte Code innerhalb der ersten Abfrage.
Member: TsukiSan
TsukiSan Jan 06, 2017 at 09:45:59 (UTC)
Goto Top
Wie UnbekannterNr1 schon schreibt, musst du deine IFs entsprechend aufbauen, wie du sie brauchst.
Momentan sieht es schemenhaft wie folgt aus:
If blblbl Ordner nicht dann
    If blablabla Ordner nicht dann
        If bla Ordner nicht dann
        End If
   End If
End If

Gruß

Tsuki
Member: Kraemer
Kraemer Jan 06, 2017 at 10:22:01 (UTC)
Goto Top
Moin,

ich weiß nun nicht genau was du da genau machst - ich denke aber, das die End-If's so gesetzt werden müssten:

WScript.Sleep 1000

Set fso = CreateObject("Scripting.FileSystemObject")  
if FSO.Folderexists("C:\Program Files (x86)\Microsoft Games\Microsoft Flight Simulator X\Addon Scenery\Europe\Italy\ATi Strade") = False then  
	CfgFilePath = "C:\ProgramData\Microsoft\FSX\Scenery.CFG"  
	Dim Record (10000)
	ScenTitle = "Title=ATi Strade"  
	EntryNumRows = 7
	Set fs = CreateObject("Scripting.FileSystemObject")   
	Set a = fs.OpenTextFile(CfgFilePath, 1, FALSE) 
	i = 1
	Do While Not a.AtEndOfStream 
		aLine = a.ReadLine
		PosTitle=Instr(1, aLine, ScenTitle)
		
		If 	PosTitle <> 0 Then
			StartRow = i-1
			EndRow = StartRow + EntryNumRows - 1
		End If 
		Record(i) = aLine
		i = i+1
	Loop 
	a.Close 
	Set a = fs.CreateTextFile(CfgFilePath, True)
	For n = 1 To i-1 
		If (n < StartRow) or (n > EndRow) then
			a.WriteLine(Record(n))
		End If
	Next
end if

Set fso = CreateObject("Scripting.FileSystemObject")  
if FSO.Folderexists("C:\Program Files (x86)\Microsoft Games\Microsoft Flight Simulator X\Addon Scenery\Europe\Italy\ATI Coste") = False then  
	ScenTitle = "Title=ATi Coste"  
	EntryNumRows = 7
	Set fs = CreateObject("Scripting.FileSystemObject")   
	Set a = fs.OpenTextFile(CfgFilePath, 1, FALSE) 
	i = 1
	Do While Not a.AtEndOfStream 
		aLine = a.ReadLine
		PosTitle=Instr(1, aLine, ScenTitle)
		If 	PosTitle <> 0 Then
			StartRow = i-1
			EndRow = StartRow + EntryNumRows - 1
		End If 
		Record(i) = aLine
		i = i+1 
	Loop 
	a.Close 
	Set a = fs.CreateTextFile(CfgFilePath, True)
	For n = 1 To i-1 
		If (n < StartRow) or (n > EndRow) then
			a.WriteLine(Record(n)) 
		End If
	Next
End if	

Set fso = CreateObject("Scripting.FileSystemObject")  
if FSO.Folderexists("C:\zATi\ATicheckfiles") = False then  
	Set FSO = CreateObject("Scripting.FileSystemObject")  
	FSO.DeleteFolder("C:\Program Files (x86)\Microsoft Games\Microsoft Flight Simulator X\Scripts")  
	Set fs = Nothing 
End if

Gruß Krämer
Member: aletri
aletri Jan 06, 2017 at 11:40:30 (UTC)
Goto Top
Hallo Krämer

Erstmal besten Dank.
Führe ich den Script nun aus kommt folgende Fehlemeldung für Zeile 37 ??
Line: 37
Cchar: 2
Error: Invalid procedure call or argument
Code: 800A0005
Mitglied: 131381
131381 Jan 06, 2017 updated at 11:46:27 (UTC)
Goto Top
Zitat von @aletri:

Hallo Krämer

Erstmal besten Dank.
Führe ich den Script nun aus kommt folgende Fehlemeldung für Zeile 37 ??
Line: 37
Cchar: 2
Error: Invalid procedure call or argument
Code: 800A0005
Na weil er die Definition der Variablen fürs Beispiel im Kopf ausgelassen hat face-wink Und diese tausenden "CreateObject" fürs FileSystemObject sind gelinde gesagt "Oberbullsshit" da reicht ein einmaliges definieren.
Immer diese Copy n' Paster am Freitag ...
CfgFilePath = "C:\ProgramData\Microsoft\FSX\Scenery.CFG"

Wohl noch keinen Kaffee intus :-P ?!

Gruß mik
Member: aletri
aletri Jan 12, 2017 at 08:24:49 (UTC)
Goto Top
Hallo mik
Script funktioniert als solcher. Wenn aber der Ordner "ATi Strade" vorhanden ist kommt Fehlermeldung:
Line: 46
Char: 3
Error: Type mismatch
Code: 800A000D
warum?

WScript.Sleep 1000

Set fso = CreateObject("Scripting.FileSystemObject")  
if FSO.Folderexists("C:\Program Files (x86)\Microsoft Games\Microsoft Flight Simulator X\Addon Scenery\Europe\Italy\ATi Strade") = False then  
	CfgFilePath = "C:\ProgramData\Microsoft\FSX\Scenery.CFG"  
	Dim Record (10000)
	ScenTitle = "Title=ATi Strade"  
	EntryNumRows = 7
	Set fs = CreateObject("Scripting.FileSystemObject")   
	Set a = fs.OpenTextFile(CfgFilePath, 1, FALSE) 
	i = 1
	Do While Not a.AtEndOfStream 
		aLine = a.ReadLine
		PosTitle=Instr(1, aLine, ScenTitle)
		
		If 	PosTitle <> 0 Then
			StartRow = i-1
			EndRow = StartRow + EntryNumRows - 1
		End If 
		Record(i) = aLine
		i = i+1
	Loop 
	a.Close 
	Set a = fs.CreateTextFile(CfgFilePath, True)
	For n = 1 To i-1 
		If (n < StartRow) or (n > EndRow) then
			a.WriteLine(Record(n))
		End If
	Next
end if

if FSO.Folderexists("C:\Program Files (x86)\Microsoft Games\Microsoft Flight Simulator X\Addon Scenery\Europe\Italy\ATI Coste") = False then  
	CfgFilePath = "C:\ProgramData\Microsoft\FSX\Scenery.CFG"  
	ScenTitle = "Title=ATi Coste"  
	EntryNumRows = 7
	Set fs = CreateObject("Scripting.FileSystemObject")   
	Set a = fs.OpenTextFile(CfgFilePath, 1, FALSE) 
	i = 1
	Do While Not a.AtEndOfStream 
		aLine = a.ReadLine
		PosTitle=Instr(1, aLine, ScenTitle)
		If 	PosTitle <> 0 Then
			StartRow = i-1
			EndRow = StartRow + EntryNumRows - 1
		End If 
		Record(i) = aLine
		i = i+1 
	Loop 
	a.Close 
	Set a = fs.CreateTextFile(CfgFilePath, True)
	For n = 1 To i-1 
		If (n < StartRow) or (n > EndRow) then
			a.WriteLine(Record(n)) 
		End If
	Next
End if	

if FSO.Folderexists("C:\zATi\ATicheckfiles") = False then  
	Set FSO = CreateObject("Scripting.FileSystemObject")  
	FSO.DeleteFolder("C:\Program Files (x86)\Microsoft Games\Microsoft Flight Simulator X\Scripts")  
	Set fs = Nothing 
End if
GermanQuestionVB for ApplicationsDevelopment