Top-Themen

AppleEntwicklungHardwareInternetLinuxMicrosoftMultimediaNetzwerkeOff TopicSicherheitSonstige SystemeVirtualisierungWeiterbildungZusammenarbeit

Aktuelle Themen

Administrator.de FeedbackApache ServerAppleAssemblerAudioAusbildungAuslandBackupBasicBatch & ShellBenchmarksBibliotheken & ToolkitsBlogsCloud-DiensteClusterCMSCPU, RAM, MainboardsCSSC und C++DatenbankenDatenschutzDebianDigitiales FernsehenDNSDrucker und ScannerDSL, VDSLE-BooksE-BusinessE-MailEntwicklungErkennung und -AbwehrExchange ServerFestplatten, SSD, RaidFirewallFlatratesGoogle AndroidGrafikGrafikkarten & MonitoreGroupwareHardwareHosting & HousingHTMLHumor (lol)Hyper-VIconsIDE & EditorenInformationsdiensteInstallationInstant MessagingInternetInternet DomäneniOSISDN & AnaloganschlüsseiTunesJavaJavaScriptKiXtartKVMLAN, WAN, WirelessLinuxLinux DesktopLinux NetzwerkLinux ToolsLinux UserverwaltungLizenzierungMac OS XMicrosoftMicrosoft OfficeMikroTik RouterOSMonitoringMultimediaMultimedia & ZubehörNetzwerkeNetzwerkgrundlagenNetzwerkmanagementNetzwerkprotokolleNotebook & ZubehörNovell NetwareOff TopicOpenOffice, LibreOfficeOutlook & MailPapierkorbPascal und DelphiPeripheriegerätePerlPHPPythonRechtliche FragenRedHat, CentOS, FedoraRouter & RoutingSambaSAN, NAS, DASSchriftartenSchulung & TrainingSEOServerServer-HardwareSicherheitSicherheits-ToolsSicherheitsgrundlagenSolarisSonstige SystemeSoziale NetzwerkeSpeicherkartenStudentenjobs & PraktikumSuche ProjektpartnerSuseSwitche und HubsTipps & TricksTK-Netze & GeräteUbuntuUMTS, EDGE & GPRSUtilitiesVB for ApplicationsVerschlüsselung & ZertifikateVideo & StreamingViren und TrojanerVirtualisierungVisual StudioVmwareVoice over IPWebbrowserWebentwicklungWeiterbildungWindows 7Windows 8Windows 10Windows InstallationWindows MobileWindows NetzwerkWindows ServerWindows SystemdateienWindows ToolsWindows UpdateWindows UserverwaltungWindows VistaWindows XPXenserverXMLZusammenarbeit
GELÖST

VBS Desktophintergrund ändern

Frage Entwicklung VB for Applications

Mitglied: novedad

novedad (Level 1) - Jetzt verbinden

06.06.2010 um 18:32 Uhr, 7779 Aufrufe, 10 Kommentare

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:

01.
On Error Resume Next 
02.
Set wshell = CreateObject("WScript.Shell")  
03.
Dim DeskPfad, Intervall 
04.
DeskPfad = InputBox("Geben Sie den Pfad zu den gewünschten Hintergrundbildern ein","WallpaperChanger") 
05.
Intervall = InputBox("Geben Sie das Intervall an in dem der Desktophintergrund geändert werden soll" &vbCrLf& "60000 Millisekunden = 1 Minute", "WallpaperChanger") 
06.
do 
07.
HKEY_CURRENT_USER = &H80000001 
08.
strComputer = "." 
09.
Set objReg = GetObject("winmgmts:\\" & strComputer & "\root\default:StdRegProv") 
10.
strKeyPath = "Control Panel\Desktop" 
11.
objReg.CreateKey HKEY_CURRENT_USER, strKeyPath 
12.
ValueName = "Wallpaper" 
13.
strValue = ""&DeskPfad&"" 
14.
objReg.SetStringValue HKEY_CURRENT_USER, strKeyPath, ValueName, strValue 
15.
wscript.sleep ""&Intervall&"" 
16.
loop
Freue mich schon auf eure Hilfe

Mit freundlichen Grüßen novedad
Mitglied: Midivirus
06.06.2010 um 20:03 Uhr
M$

Sys > Anzeige > Slide Show > fertig
Bitte warten ..
Mitglied: novedad
06.06.2010 um 20:26 Uhr
ich hab WINDOWS XP, da geht leider keine Slideshow

eine Scriptbasierte Lösung wäre besser...
Bitte warten ..
Mitglied: bastla
06.06.2010 um 23:21 Uhr
Hallo novedad!

Ich nehme an, Du meinst das etwa so:
01.
On Error Resume Next 
02.
Set wshell = CreateObject("WScript.Shell") 
03.
Set fso = CreateObject("Scripting.FileSystemObject") 
04.
HKEY_CURRENT_USER = &H80000001 
05.
strComputer = "." 
06.
Set objReg = GetObject("winmgmts:\\" & strComputer & "\root\default:StdRegProv") 
07.
strKeyPath = "Control Panel\Desktop" 
08.
objReg.CreateKey HKEY_CURRENT_USER, strKeyPath 
09.
Ext = "#jpg#bmp#" 
10.
 
11.
Randomize 
12.
 
13.
DeskPfad = InputBox("Geben Sie den Pfad zu den gewünschten Hintergrundbildern ein","WallpaperChanger") 
14.
Intervall = InputBox("Geben Sie das Intervall an in dem der Desktophintergrund geändert werden soll" &vbCrLf& "60000 Millisekunden = 1 Minute", "WallpaperChanger") 
15.
 
16.
Do 
17.
    Pics = "" 'String zum Sammeln aller Dateipfade leeren für neuen Durchgang - könnten ja diesmal mehr oder weniger Bilder sein ... 
18.
    For Each File In fso.GetFolder(Deskpfad).Files '... daher immer alle Dateien des gewählten Ordners durchgehen ... 
19.
        If Instr(Ext, "#" & LCase(fso.GetExtensionName(File.Name)) & "#") > 0  Then '... aber nur solche mit passendem Typ berücksichtigen 
20.
            Pics = Pics & "§" & File.Path 'Pfad durch "§" getrennt an den Sammelstring anfügen 
21.
        End If 
22.
    Next 
23.
    P = Split(Mid(Pics, 2), "§") 'aus dem Sammelstring ein Array machen (vor dem ersten Trennzeichen steht nix, daher dahinter anfangen)... 
24.
    PicPath = P(Int(Rnd * (UBound(P) + 1))) ' ... und per Zufallszahlenfunktion einen Pfad auswählen 
25.
 
26.
    ValueName = PicPath 
27.
    strValue = DeskPfad 
28.
    objReg.SetStringValue HKEY_CURRENT_USER, strKeyPath, ValueName, strValue 
29.
    WScript.Sleep Intervall 
30.
Loop
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:
strValue = """" & DeskPfad & """"
oder, etwas pflegeleichter
strValue = Chr(34) & DeskPfad & Chr(34)
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 "Dim" verwendest, dann aber konsequent für alle Variablen (also auch "wshell", ...) und zusammen mit einem "Option Explicit" ...

Grüße
bastla
Bitte warten ..
Mitglied: novedad
07.06.2010 um 19:02 Uhr
erstmal danke @ bastla

doch es funktioniert leider nicht so wie ich dachte

ich verwende nun das
Script von Bastla

01.
On Error Resume Next 
02.
Set wshell = CreateObject("WScript.Shell") 
03.
Set fso = CreateObject("Scripting.FileSystemObject") 
04.
HKEY_CURRENT_USER = &H80000001 
05.
strComputer = "." 
06.
Set objReg = GetObject("winmgmts:\\" & strComputer & "\root\default:StdRegProv") 
07.
strKeyPath = "Control Panel\Desktop" 
08.
objReg.CreateKey HKEY_CURRENT_USER, strKeyPath 
09.
Ext = "#jpg#bmp#" 
10.
 
11.
Randomize 
12.
 
13.
DeskPfad = InputBox("Geben Sie den Pfad zu den gewünschten Hintergrundbildern ein","WallpaperChanger") 
14.
Intervall = InputBox("Geben Sie das Intervall an in dem der Desktophintergrund geändert werden soll" &vbCrLf& "60000 Millisekunden = 1 Minute", "WallpaperChanger") 
15.
 
16.
Do 
17.
    Pics = "" 'String zum Sammeln aller Dateipfade leeren für neuen Durchgang - könnten ja diesmal mehr oder weniger Bilder sein ... 
18.
    For Each File In fso.GetFolder(Deskpfad).Files '... daher immer alle Dateien des gewählten Ordners durchgehen ... 
19.
        If Instr(Ext, "#" & LCase(fso.GetExtensionName(File.Name)) & "#") > 0  Then '... aber nur solche mit passendem Typ berücksichtigen 
20.
            Pics = Pics & "§" & File.Path 'Pfad durch "§" getrennt an den Sammelstring anfügen 
21.
        End If 
22.
    Next 
23.
    P = Split(Mid(Pics, 2), "§") 'aus dem Sammelstring ein Array machen (vor dem ersten Trennzeichen steht nix, daher dahinter anfangen)... 
24.
    PicPath = P(Int(Rnd * (UBound(P) + 1))) ' ... und per Zufallszahlenfunktion einen Pfad auswählen 
25.
 
26.
    ValueName = PicPath 
27.
    strValue = DeskPfad 
28.
    objReg.SetStringValue HKEY_CURRENT_USER, strKeyPath, ValueName, strValue 
29.
    WScript.Sleep Intervall 
30.
Loop
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:

01.
@echo off 
02.
%SystemRoot%\System32\RUNDLL32.EXE user32.dll, UpdatePerUserSystemParameters
doch es passiert - einfach nichts

irgendwo muss da der Fehler liegen doch ich steh' gerade auf dem Schlauch

danke für eure Antworten

Mit freundlichen Grüßen novedad
Bitte warten ..
Mitglied: bastla
07.06.2010 um 23:22 Uhr
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
Bitte warten ..
Mitglied: novedad
07.06.2010 um 23:28 Uhr
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

Mit freundlichen Grüßen novedad
Bitte warten ..
Mitglied: bastla
07.06.2010 um 23:41 Uhr
Hallo novedad!

Ist schon klar - die Zeilen 26 und 27 sind so ja einfach Blödsinn - besser wäre:
    ValueName = "Wallpaper" 
    strValue = PicPath
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:
    strValue = """" & PicPath & """"
Grüße
bastla
Bitte warten ..
Mitglied: novedad
08.06.2010 um 13:52 Uhr
funktioniert wunderbar!

hier noch einmal der komplette Code:

WallpaperChanger:

01.
On Error Resume Next 
02.
Set wshell = CreateObject("WScript.Shell") 
03.
Set fso = CreateObject("Scripting.FileSystemObject") 
04.
HKEY_CURRENT_USER = &H80000001 
05.
strComputer = "." 
06.
Set objReg = GetObject("winmgmts:\\" & strComputer & "\root\default:StdRegProv") 
07.
strKeyPath = "Control Panel\Desktop" 
08.
objReg.CreateKey HKEY_CURRENT_USER, strKeyPath 
09.
Ext = "#jpg#bmp#" 
10.
 
11.
Randomize 
12.
 
13.
DeskPfad = InputBox("Geben Sie den Pfad zu den gewünschten Hintergrundbildern ein","WallpaperChanger") 
14.
Intervall = InputBox("Geben Sie das Intervall an in dem der Desktophintergrund geändert werden soll" &vbCrLf& "60000 Millisekunden = 1 Minute", "WallpaperChanger") 
15.
 
16.
Do 
17.
    Pics = "" 'String zum Sammeln aller Dateipfade leeren für neuen Durchgang - könnten ja diesmal mehr oder weniger Bilder sein ... 
18.
    For Each File In fso.GetFolder(Deskpfad).Files '... daher immer alle Dateien des gewählten Ordners durchgehen ... 
19.
        If Instr(Ext, "#" & LCase(fso.GetExtensionName(File.Name)) & "#") > 0  Then '... aber nur solche mit passendem Typ berücksichtigen 
20.
            Pics = Pics & "§" & File.Path 'Pfad durch "§" getrennt an den Sammelstring anfügen 
21.
        End If 
22.
    Next 
23.
    P = Split(Mid(Pics, 2), "§") 'aus dem Sammelstring ein Array machen (vor dem ersten Trennzeichen steht nix, daher dahinter anfangen)... 
24.
    PicPath = P(Int(Rnd * (UBound(P) + 1))) ' ... und per Zufallszahlenfunktion einen Pfad auswählen 
25.
 
26.
    ValueName = "Wallpaper"  
27.
    strValue = PicPath 
28.
    objReg.SetStringValue HKEY_CURRENT_USER, strKeyPath, ValueName, strValue 
29.
    WScript.Sleep Intervall 
30.
    wshell.run "Update.bat",0, True 
31.
Loop
RegistryUpdater:

01.
@echo off 
02.
%SystemRoot%\System32\RUNDLL32.EXE user32.dll, UpdatePerUserSystemParameters

Noch einmal vielen Dank an bastla der mit bei der Lösung meins Problems geholfen hat!

Mit freundlichen Grüßen novedad
Bitte warten ..
Mitglied: bastla
08.06.2010 um 14:30 Uhr
Hallo novedad!

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
Grüße
bastla
Bitte warten ..
Mitglied: novedad
08.06.2010 um 17:09 Uhr
Gute Idee

Danke!

Mit freundlichen Grüßen novedad
Bitte warten ..
Neuester Wissensbeitrag
Humor (lol)

Linkliste für Adventskalender

(3)

Information von nikoatit zum Thema Humor (lol) ...

Ähnliche Inhalte
Batch & Shell
Eventlog Druckjobs mit VBS auslesen

Frage von joni2000de zum Thema Batch & Shell ...

VB for Applications
VBS Script zum versenden mehrerer Verknüpfungen zu Dateien per Lotus Notes

Frage von Sentinel87 zum Thema VB for Applications ...

Windows Server
gelöst Word 2010 : Absatz - Abstand per GPO ändern (3)

Frage von johanna-p zum Thema Windows Server ...

Windows 10
Desktophintergrund via GPO Diashow Problem (3)

Frage von maddig zum Thema Windows 10 ...

Heiß diskutierte Inhalte
Router & Routing
gelöst Ipv4 mieten (22)

Frage von homermg zum Thema Router & Routing ...

Windows Server
DHCP Server switchen (20)

Frage von M.Marz zum Thema Windows Server ...

Exchange Server
gelöst Exchange 2010 Berechtigungen wiederherstellen (20)

Frage von semperf1delis zum Thema Exchange Server ...

Hardware
gelöst Negative Erfahrungen LAN-Karten (19)

Frage von MegaGiga zum Thema Hardware ...