10
VBS Desktophintergrund ändern
Hallo
Habe ein Script geschrieben mit dem der Desktophintergrund von Windows XP in einem bestimmbaren Intervall geändert werden soll
Mit einem einzelnen Bild klappt es, aber das ist ja nicht der Sinn der Sache
Ich will das ich nur einen Ordner auszuwählen brauche der die Bilder enthält und den Desktophintergrund dann nach einer bestimmten Zeit ändert
Hier mein Script:
Freue mich schon auf eure Hilfe
mfg novedad
Habe ein Script geschrieben mit dem der Desktophintergrund von Windows XP in einem bestimmbaren Intervall geändert werden soll
Mit einem einzelnen Bild klappt es, aber das ist ja nicht der Sinn der Sache
Ich will das ich nur einen Ordner auszuwählen brauche der die Bilder enthält und den Desktophintergrund dann nach einer bestimmten Zeit ändert
Hier mein Script:
On Error Resume Next
Set wshell = CreateObject("WScript.Shell")
Dim DeskPfad, Intervall
DeskPfad = InputBox("Geben Sie den Pfad zu den gewünschten Hintergrundbildern ein","WallpaperChanger")
Intervall = InputBox("Geben Sie das Intervall an in dem der Desktophintergrund geändert werden soll" &vbCrLf& "60000 Millisekunden = 1 Minute", "WallpaperChanger")
do
HKEY_CURRENT_USER = &H80000001
strComputer = "."
Set objReg = GetObject("winmgmts:\\" & strComputer & "\root\default:StdRegProv")
strKeyPath = "Control Panel\Desktop"
objReg.CreateKey HKEY_CURRENT_USER, strKeyPath
ValueName = "Wallpaper"
strValue = ""&DeskPfad&""
objReg.SetStringValue HKEY_CURRENT_USER, strKeyPath, ValueName, strValue
wscript.sleep ""&Intervall&""
loopFreue mich schon auf eure Hilfe
mfg novedad
Auf Facebook teilen
Auf Twitter teilen
Auf Reddit teilen
Auf Linkedin teilenBitte markiere auch die Kommentare, die zur Lösung des Beitrags beigetragen haben
Content-ID: 144251
Url: https://administrator.de/contentid/144251
Ausgedruckt am: 20.11.2024 um 14:11 Uhr
10 Kommentare
Neuester Kommentar
ich hab WINDOWS XP, da geht leider keine Slideshow
eine Scriptbasierte Lösung wäre besser...
eine Scriptbasierte Lösung wäre besser...
Hallo novedad!
Ich nehme an, Du meinst das etwa so:
Ist ungetestet, enthält aber im Vergleich zu vorher etwas weniger abenteuerliche Anführungszeichen ... 
Falls Du den Wert von "Deskpfad" tatsächlich unter Anführungszeichen benötigen solltest, müsste die entsprechende Zeile so aussehen:
oder, etwas pflegeleichter
Das in Zeile 20 und 23 verwendete Zeichen "§" dient als Trennzeichen und sollte in keinem Dateinamen / -pfad enthalten sein - ggf gegen etwas noch exotischeres tauschen ...
Die Liste der erlaubten Dateitypen in Zeile 9 kannst Du nach Bedarf erweitern, aber bitte immer mit "#" beginnen, trennen und beenden und nur Kleinbuchstaben verwenden ...
Letzte Anmerkung: Wenn Du schon "
Grüße
bastla
Ich nehme an, Du meinst das etwa so:
On Error Resume Next
Set wshell = CreateObject("WScript.Shell")
Set fso = CreateObject("Scripting.FileSystemObject")
HKEY_CURRENT_USER = &H80000001
strComputer = "."
Set objReg = GetObject("winmgmts:\\" & strComputer & "\root\default:StdRegProv")
strKeyPath = "Control Panel\Desktop"
objReg.CreateKey HKEY_CURRENT_USER, strKeyPath
Ext = "#jpg#bmp#"
Randomize
DeskPfad = InputBox("Geben Sie den Pfad zu den gewünschten Hintergrundbildern ein","WallpaperChanger")
Intervall = InputBox("Geben Sie das Intervall an in dem der Desktophintergrund geändert werden soll" &vbCrLf& "60000 Millisekunden = 1 Minute", "WallpaperChanger")
Do
Pics = "" 'String zum Sammeln aller Dateipfade leeren für neuen Durchgang - könnten ja diesmal mehr oder weniger Bilder sein ...
For Each File In fso.GetFolder(Deskpfad).Files '... daher immer alle Dateien des gewählten Ordners durchgehen ...
If Instr(Ext, "#" & LCase(fso.GetExtensionName(File.Name)) & "#") > 0 Then '... aber nur solche mit passendem Typ berücksichtigen
Pics = Pics & "§" & File.Path 'Pfad durch "§" getrennt an den Sammelstring anfügen
End If
Next
P = Split(Mid(Pics, 2), "§") 'aus dem Sammelstring ein Array machen (vor dem ersten Trennzeichen steht nix, daher dahinter anfangen)...
PicPath = P(Int(Rnd * (UBound(P) + 1))) ' ... und per Zufallszahlenfunktion einen Pfad auswählen
ValueName = PicPath
strValue = DeskPfad
objReg.SetStringValue HKEY_CURRENT_USER, strKeyPath, ValueName, strValue
WScript.Sleep Intervall
LoopFalls Du den Wert von "Deskpfad" tatsächlich unter Anführungszeichen benötigen solltest, müsste die entsprechende Zeile so aussehen:
strValue = """" & DeskPfad & """"
strValue = Chr(34) & DeskPfad & Chr(34)
Die Liste der erlaubten Dateitypen in Zeile 9 kannst Du nach Bedarf erweitern, aber bitte immer mit "#" beginnen, trennen und beenden und nur Kleinbuchstaben verwenden ...
Letzte Anmerkung: Wenn Du schon "
Dim" verwendest, dann aber konsequent für alle Variablen (also auch "wshell", ...) und zusammen mit einem "Option Explicit" ...Grüße
bastla
erstmal danke @ bastla
doch es funktioniert leider nicht so wie ich dachte
ich verwende nun das
Script von Bastla
und gebe als Pfad meinetwegen C:\Wallpapers an. In diesem Ordner befinden sich 10 Bilder im .bmp-Format
Als Intervall gebe ich 300000 Millisekunden = 5 Minuten an
dann verwende ich noch eine Batch zum Updaten des Systems mit folgendem Inhalt:
doch es passiert - einfach nichts
irgendwo muss da der Fehler liegen doch ich steh' gerade auf dem Schlauch
danke für eure Antworten
mfg novedad
doch es funktioniert leider nicht so wie ich dachte
ich verwende nun das
Script von Bastla
On Error Resume Next
Set wshell = CreateObject("WScript.Shell")
Set fso = CreateObject("Scripting.FileSystemObject")
HKEY_CURRENT_USER = &H80000001
strComputer = "."
Set objReg = GetObject("winmgmts:\\" & strComputer & "\root\default:StdRegProv")
strKeyPath = "Control Panel\Desktop"
objReg.CreateKey HKEY_CURRENT_USER, strKeyPath
Ext = "#jpg#bmp#"
Randomize
DeskPfad = InputBox("Geben Sie den Pfad zu den gewünschten Hintergrundbildern ein","WallpaperChanger")
Intervall = InputBox("Geben Sie das Intervall an in dem der Desktophintergrund geändert werden soll" &vbCrLf& "60000 Millisekunden = 1 Minute", "WallpaperChanger")
Do
Pics = "" 'String zum Sammeln aller Dateipfade leeren für neuen Durchgang - könnten ja diesmal mehr oder weniger Bilder sein ...
For Each File In fso.GetFolder(Deskpfad).Files '... daher immer alle Dateien des gewählten Ordners durchgehen ...
If Instr(Ext, "#" & LCase(fso.GetExtensionName(File.Name)) & "#") > 0 Then '... aber nur solche mit passendem Typ berücksichtigen
Pics = Pics & "§" & File.Path 'Pfad durch "§" getrennt an den Sammelstring anfügen
End If
Next
P = Split(Mid(Pics, 2), "§") 'aus dem Sammelstring ein Array machen (vor dem ersten Trennzeichen steht nix, daher dahinter anfangen)...
PicPath = P(Int(Rnd * (UBound(P) + 1))) ' ... und per Zufallszahlenfunktion einen Pfad auswählen
ValueName = PicPath
strValue = DeskPfad
objReg.SetStringValue HKEY_CURRENT_USER, strKeyPath, ValueName, strValue
WScript.Sleep Intervall
Loopund gebe als Pfad meinetwegen C:\Wallpapers an. In diesem Ordner befinden sich 10 Bilder im .bmp-Format
Als Intervall gebe ich 300000 Millisekunden = 5 Minuten an
dann verwende ich noch eine Batch zum Updaten des Systems mit folgendem Inhalt:
@echo off
%SystemRoot%\System32\RUNDLL32.EXE user32.dll, UpdatePerUserSystemParametersdoch es passiert - einfach nichts
irgendwo muss da der Fehler liegen doch ich steh' gerade auf dem Schlauch
danke für eure Antworten
mfg novedad
Hallo novedad!
Wie rufst Du denn Deine Batchdatei auf?
Um das Ganze etwas einzugrenzen, könntest Du ja mal in der Registry nachsehen, ob überhaupt ein Wert eingetragen wurde ...
Grüße
bastla
Wie rufst Du denn Deine Batchdatei auf?
Um das Ganze etwas einzugrenzen, könntest Du ja mal in der Registry nachsehen, ob überhaupt ein Wert eingetragen wurde ...
Grüße
bastla
Hallo bastla
In der Registry wurde nichts eingetragen, da hab ich schon nachgeschaut
Die Batchdatei soll nur dazu dienen die Änderungen in der Registry zu übernehmen ohne den PC neustarten zu müssen
mfg novedad
In der Registry wurde nichts eingetragen, da hab ich schon nachgeschaut
Die Batchdatei soll nur dazu dienen die Änderungen in der Registry zu übernehmen ohne den PC neustarten zu müssen
mfg novedad
Hallo novedad!
Ist schon klar - die Zeilen 26 und 27 sind so ja einfach Blödsinn
- besser wäre:
Ob die Anführungszeichen um den Pfad tatsächlich gebraucht werden oder zumindest nicht schaden, weiß ich nicht, aber Du kannst ja mal die Zeile 27 so testen:
Grüße
bastla
Ist schon klar - die Zeilen 26 und 27 sind so ja einfach Blödsinn
- besser wäre: ValueName = "Wallpaper"
strValue = PicPath
strValue = """" & PicPath & """"
bastla
funktioniert wunderbar!
hier noch einmal der komplette Code:
WallpaperChanger:
RegistryUpdater:
Noch einmal vielen Dank an bastla der mit bei der Lösung meins Problems geholfen hat!
mfg novedad
hier noch einmal der komplette Code:
WallpaperChanger:
On Error Resume Next
Set wshell = CreateObject("WScript.Shell")
Set fso = CreateObject("Scripting.FileSystemObject")
HKEY_CURRENT_USER = &H80000001
strComputer = "."
Set objReg = GetObject("winmgmts:\\" & strComputer & "\root\default:StdRegProv")
strKeyPath = "Control Panel\Desktop"
objReg.CreateKey HKEY_CURRENT_USER, strKeyPath
Ext = "#jpg#bmp#"
Randomize
DeskPfad = InputBox("Geben Sie den Pfad zu den gewünschten Hintergrundbildern ein","WallpaperChanger")
Intervall = InputBox("Geben Sie das Intervall an in dem der Desktophintergrund geändert werden soll" &vbCrLf& "60000 Millisekunden = 1 Minute", "WallpaperChanger")
Do
Pics = "" 'String zum Sammeln aller Dateipfade leeren für neuen Durchgang - könnten ja diesmal mehr oder weniger Bilder sein ...
For Each File In fso.GetFolder(Deskpfad).Files '... daher immer alle Dateien des gewählten Ordners durchgehen ...
If Instr(Ext, "#" & LCase(fso.GetExtensionName(File.Name)) & "#") > 0 Then '... aber nur solche mit passendem Typ berücksichtigen
Pics = Pics & "§" & File.Path 'Pfad durch "§" getrennt an den Sammelstring anfügen
End If
Next
P = Split(Mid(Pics, 2), "§") 'aus dem Sammelstring ein Array machen (vor dem ersten Trennzeichen steht nix, daher dahinter anfangen)...
PicPath = P(Int(Rnd * (UBound(P) + 1))) ' ... und per Zufallszahlenfunktion einen Pfad auswählen
ValueName = "Wallpaper"
strValue = PicPath
objReg.SetStringValue HKEY_CURRENT_USER, strKeyPath, ValueName, strValue
WScript.Sleep Intervall
wshell.run "Update.bat",0, True
LoopRegistryUpdater:
@echo off
%SystemRoot%\System32\RUNDLL32.EXE user32.dll, UpdatePerUserSystemParametersNoch einmal vielen Dank an bastla der mit bei der Lösung meins Problems geholfen hat!
mfg novedad
Hallo novedad!
Eigentlich sollte sich die Batchdatei auch einsparen und die eine Zeile direkt aus dem VBScript ausführen lassen:
Grüße
bastla
Eigentlich sollte sich die Batchdatei auch einsparen und die eine Zeile direkt aus dem VBScript ausführen lassen:
wshell.run "RUNDLL32.EXE user32.dll, UpdatePerUserSystemParameters",0, True
bastla
Gute Idee
Danke!
mfg novedad
Danke!
mfg novedad
