Outbreaker Posted January 7, 2009 Share Posted January 7, 2009 (edited) HI I have a VBScript and i want to change it so i can set the Theme over Command Line like:Start "" /wait "Apply Theme.vbs" "Theme Name"And a little check script if the Theme does not exist then a popup box should cam and say Theme not found in ""%SystemRoot%\Resources\Themes" folder.' Apply Costume Windows XP Theme.Set OSHApp = CreateObject("Shell.Application")Set oShell = CreateObject("Wscript.Shell")oSHApp.ControlPanelItem cstr("desk.cpl desk,@Themes /Action:OpenTheme /file:" ^& """" + "%SystemRoot%\Resources\Themes\blabla.theme" + """")While OShell.AppActivate ("Display Properties") = FALSE Wscript.Sleep 1000WendWhile OShell.AppActivate ("Display Properties") = TRUE oShell.AppActivate "Display Properties" Wscript.Sleep 200 oShell.sendkeys "{ENTER}"Wend Edited January 7, 2009 by Outbreaker Link to comment Share on other sites More sharing options...
gunsmokingman Posted January 7, 2009 Share Posted January 7, 2009 Here try this' Apply Costume Windows XP Theme. Dim Fso :Set Fso = CreateObject("Scripting.FileSystemObject") Dim OSHApp :Set OSHApp = CreateObject("Shell.Application") Dim oShell :Set oShell = CreateObject("Wscript.Shell") Dim MyTheme :MyTheme = "%SystemRoot%\Resources\Themes\blabla.theme" If Fso.FileExists(MyTheme) Then oSHApp.ControlPanelItem cstr("desk.cpl desk,@Themes /Action:OpenTheme /file:" & """" + MyTheme + """") While OShell.AppActivate ("Display Properties") = FALSE Wscript.Sleep 1000 Wend While OShell.AppActivate ("Display Properties") = TRUE oShell.AppActivate "Display Properties" Wscript.Sleep 200 oShell.sendkeys "{ENTER}" Wend Else MsgBox vbTab & "Error Missing Theme" & vbCrLf & MyTheme,4128, "Error Missing Theme" End if Link to comment Share on other sites More sharing options...
Outbreaker Posted January 7, 2009 Author Share Posted January 7, 2009 I get always the missing Theme error. Link to comment Share on other sites More sharing options...
gunsmokingman Posted January 8, 2009 Share Posted January 8, 2009 Try this' Apply Costume Windows XP Theme.Dim Fso :Set Fso = CreateObject("Scripting.FileSystemObject")Dim OSHApp :Set OSHApp = CreateObject("Shell.Application")Dim oShell :Set oShell = CreateObject("Wscript.Shell")Dim MyTheme :MyTheme = oShell.ExpandEnvironmentStrings("%SystemRoot%\Resources\Themes\blabla.theme") If Fso.FileExists(MyTheme) Then oSHApp.ControlPanelItem cstr("desk.cpl desk,@Themes /Action:OpenTheme /file:" & """" + MyTheme + """") While OShell.AppActivate ("Display Properties") = FALSE Wscript.Sleep 1000 Wend While OShell.AppActivate ("Display Properties") = TRUE oShell.AppActivate "Display Properties" Wscript.Sleep 200 oShell.sendkeys "{ENTER}" Wend Else MsgBox vbTab & "Error Missing Theme" & vbCrLf & MyTheme,4128, "Error Missing Theme" End if Link to comment Share on other sites More sharing options...
Outbreaker Posted January 8, 2009 Author Share Posted January 8, 2009 No also not working If i use:Start "" /wait "Apply Theme.vbs" "Theme_Name.theme"orStart "" /wait "Apply Theme.vbs" "Theme_Name"Then i get always the error "C:\WINDOWS\Resources\Themes\blabla.theme" is missing.Should it not be "C:\WINDOWS\Resources\Themes\Theme_Name.theme" is missing ? Link to comment Share on other sites More sharing options...
gunsmokingman Posted January 8, 2009 Share Posted January 8, 2009 I ran the script and it works fine when I added Dim MyTheme :MyTheme = oShell.ExpandEnvironmentStrings("%SystemRoot%\Resources\Themes\GsmGrey.Theme")I do not know how to pass a varible from cmd promt to vbs script.Here is a vbs script all you have to do is drag a theme file on to it.Option Explicit Dim Act :Set Act = CreateObject("Wscript.Shell") Dim Shl :Set Shl = CreateObject("Shell.Application") If Wscript.Arguments.Count = 0 Then msgbox vbtab & "Error No Drag And Drop" & vbCrLf & _ "Please Drag And Drop A Theme File On This Script" ,4128,"Error No Drag Drop" Else Dim Obj For Each Obj In WScript.Arguments If Right(InStr(LCase(Obj),Lcase(".Theme")),6) Then ApplyTheme() End If Next End If Function ApplyTheme() Shl.ControlPanelItem cstr("desk.cpl desk,@Themes /Action:OpenTheme /file:" & """" + Obj + """") While Act.AppActivate ("Display Properties") = False Wscript.Sleep 1000 Wend While Act.AppActivate ("Display Properties") = TRUE Act.AppActivate "Display Properties" Wscript.Sleep 200 Act.sendkeys "{ENTER}" Wend End Function Link to comment Share on other sites More sharing options...
hessam Posted January 9, 2009 Share Posted January 9, 2009 I ran the script and it works fine when I added Dim MyTheme :MyTheme = oShell.ExpandEnvironmentStrings("%SystemRoot%\Resources\Themes\GsmGrey.Theme")I do not know how to pass a varible from cmd promt to vbs script.Here is a vbs script all you have to do is drag a theme file on to it.Option Explicit Dim Act :Set Act = CreateObject("Wscript.Shell") Dim Shl :Set Shl = CreateObject("Shell.Application") If Wscript.Arguments.Count = 0 Then msgbox vbtab & "Error No Drag And Drop" & vbCrLf & _ "Please Drag And Drop A Theme File On This Script" ,4128,"Error No Drag Drop" Else Dim Obj For Each Obj In WScript.Arguments If Right(InStr(LCase(Obj),Lcase(".Theme")),6) Then ApplyTheme() End If Next End If Function ApplyTheme() Shl.ControlPanelItem cstr("desk.cpl desk,@Themes /Action:OpenTheme /file:" & """" + Obj + """") While Act.AppActivate ("Display Properties") = False Wscript.Sleep 1000 Wend While Act.AppActivate ("Display Properties") = TRUE Act.AppActivate "Display Properties" Wscript.Sleep 200 Act.sendkeys "{ENTER}" Wend End Functionif you can create js or vbs to automatic set theme without dragdrop Link to comment Share on other sites More sharing options...
gunsmokingman Posted January 9, 2009 Share Posted January 9, 2009 Here just fill in the required theme path and name and it should work.Option ExplicitDim Act :Set Act = CreateObject("Wscript.Shell")Dim Fso :Set Fso = CreateObject("Scripting.FileSystemObject")Dim Shl :Set Shl = CreateObject("Shell.Application")Dim Thm :Thm = Act.ExpandEnvironmentStrings("%Windir%\PATH_TO_THEME\THEME_NAME") If Fso.FileExists(Thm) Then ApplyTheme() Else Msgbox("Can Not Find This Theme" & Thm, 4128, "Error No Theme" End If Function ApplyTheme() Shl.ControlPanelItem cstr("desk.cpl desk,@Themes /Action:OpenTheme /file:" & """" + Thm + """") While Act.AppActivate ("Display Properties") = False Wscript.Sleep 1000 Wend While Act.AppActivate ("Display Properties") = TRUE Act.AppActivate "Display Properties" Wscript.Sleep 200 Act.sendkeys "{ENTER}" Wend End Function Link to comment Share on other sites More sharing options...
hessam Posted January 9, 2009 Share Posted January 9, 2009 dont work get error line:10 char:66 error:expected code:800A03EEOption ExplicitDim Act :Set Act = CreateObject("Wscript.Shell")Dim Fso :Set Fso = CreateObject("Scripting.FileSystemObject")Dim Shl :Set Shl = CreateObject("Shell.Application")Dim Thm :Thm = Act.ExpandEnvironmentStrings("%Windir%\Resources\Themes\Windows Classic.theme") If Fso.FileExists(Thm) Then ApplyTheme() Else Msgbox("Can Not Find This Theme" & Thm, 4128, "Error No Theme" End If Function ApplyTheme() Shl.ControlPanelItem cstr("desk.cpl desk,@Themes /Action:OpenTheme /file:" & """" + Thm + """") While Act.AppActivate ("Display Properties") = False Wscript.Sleep 1000 Wend While Act.AppActivate ("Display Properties") = TRUE Act.AppActivate "Display Properties" Wscript.Sleep 200 Act.sendkeys "{ENTER}" Wend End Function Link to comment Share on other sites More sharing options...
gunsmokingman Posted January 10, 2009 Share Posted January 10, 2009 This is what was causing the mistake Msgbox("Can Not Find This Theme" & Thm, 4128, "Error No Theme"Should be this Msgbox "Can Not Find This Theme" & Thm, 4128, "Error No Theme"Re-writen Code tested Option Explicit Dim Act :Set Act = CreateObject("Wscript.Shell") Dim Fso :Set Fso = CreateObject("Scripting.FileSystemObject") Dim Shl :Set Shl = CreateObject("Shell.Application") Dim Thm :Thm = Act.ExpandEnvironmentStrings("%Windir%\Resources\Themes\Windows Classic.theme") If Fso.FileExists(Thm) Then ApplyTheme() Else Msgbox "Can Not Find This Theme" & vbCrLf & Thm, 4128, "Error No Theme" End If Function ApplyTheme() Shl.ControlPanelItem cstr("desk.cpl desk,@Themes /Action:OpenTheme /file:" & """" + Thm + """") While Act.AppActivate("Display Properties") = False Wscript.Sleep 1000 Wend While Act.AppActivate("Display Properties") = TRUE Act.AppActivate "Display Properties" Wscript.Sleep 200 Act.sendkeys "{ENTER}" Wend End Function Link to comment Share on other sites More sharing options...
Outbreaker Posted January 10, 2009 Author Share Posted January 10, 2009 (edited) Dim Act :Set Act = CreateObject("Wscript.Shell")Dim Shl :Set Shl = CreateObject("Shell.Application") If Wscript.Arguments.Count = 0 Then msgbox vbtab & "Error No Drag And Drop" & vbCrLf & _ "Please Drag And Drop A Theme File On This Script" ,4128,"Error No Drag Drop" Else Dim Obj For Each Obj In WScript.Arguments If Right(InStr(LCase(Obj),Lcase(".Theme")),6) Then ApplyTheme() End If Next End If Function ApplyTheme() Shl.ControlPanelItem cstr("desk.cpl desk,@Themes /Action:OpenTheme /file:" & """" + Obj + """") While Act.AppActivate ("Display Properties") = False Wscript.Sleep 1000 Wend While Act.AppActivate ("Display Properties") = TRUE Act.AppActivate "Display Properties" Wscript.Sleep 200 Act.sendkeys "{ENTER}" Wend End FunctionGood this dragdrop script will also work whit the CMD-Box like:"test.vbs" "C:\WINDOWS\Resources\Themes\My_Theme.theme"Now it would be good if we enter a wrong Theme in the CMD-Box like:"test.vbs" "C:\WINDOWS\Resources\Themes\My_Theme1.theme"Then it would be good to get a error message and the script should also stop appying this Theme. Like the error option if you would click on the "test.vbs" file. Edited January 10, 2009 by Outbreaker Link to comment Share on other sites More sharing options...
gunsmokingman Posted January 10, 2009 Share Posted January 10, 2009 This will not apply the luna theme, it is still drag and drop.Option Explicit Dim Act :Set Act = CreateObject("Wscript.Shell") Dim Shl :Set Shl = CreateObject("Shell.Application") If Wscript.Arguments.Count = 0 Then msgbox vbtab & "Error No Drag And Drop" & vbCrLf & _ "Please Drag And Drop A Theme File On This Script" ,4128,"Error No Drag Drop" Else Dim Obj For Each Obj In WScript.Arguments If Right(InStr(LCase(Obj),Lcase(".Theme")),6) Then If InStr(LCase(Obj),LCase("Luna")) Then msgbox vbtab & "Error Luna Theme" & vbCrLf & _ "This Theme Will Not be Applied, Select Another Theme" ,4128, "Error Luna Theme" Else ApplyTheme() End if End If Next End If Function ApplyTheme() Shl.ControlPanelItem cstr("desk.cpl desk,@Themes /Action:OpenTheme /file:" & """" + Obj + """") While Act.AppActivate ("Display Properties") = False Wscript.Sleep 1000 Wend While Act.AppActivate ("Display Properties") = TRUE Act.AppActivate "Display Properties" Wscript.Sleep 200 Act.sendkeys "{ENTER}" Wend End Function Link to comment Share on other sites More sharing options...
hessam Posted January 10, 2009 Share Posted January 10, 2009 This is what was causing the mistake Msgbox("Can Not Find This Theme" & Thm, 4128, "Error No Theme"Should be this Msgbox "Can Not Find This Theme" & Thm, 4128, "Error No Theme"Re-writen Code tested Option Explicit Dim Act :Set Act = CreateObject("Wscript.Shell") Dim Fso :Set Fso = CreateObject("Scripting.FileSystemObject") Dim Shl :Set Shl = CreateObject("Shell.Application") Dim Thm :Thm = Act.ExpandEnvironmentStrings("%Windir%\Resources\Themes\Windows Classic.theme") If Fso.FileExists(Thm) Then ApplyTheme() Else Msgbox "Can Not Find This Theme" & vbCrLf & Thm, 4128, "Error No Theme" End If Function ApplyTheme() Shl.ControlPanelItem cstr("desk.cpl desk,@Themes /Action:OpenTheme /file:" & """" + Thm + """") While Act.AppActivate("Display Properties") = False Wscript.Sleep 1000 Wend While Act.AppActivate("Display Properties") = TRUE Act.AppActivate "Display Properties" Wscript.Sleep 200 Act.sendkeys "{ENTER}" Wend End FunctionThanyou very much great help its working it possible to do not show display propertis Link to comment Share on other sites More sharing options...
Outbreaker Posted January 11, 2009 Author Share Posted January 11, 2009 This would be also handy:Fortunately there is an alternate solution to this script and its SendKeys: send a BM_CLICK window message to the button we need to press in the required Theme window. This way we can warrantee that we close the right window by pressing the right button.http://blogs.msdn.com/alejacma/archive/200...ally-in-xp.aspx Link to comment Share on other sites More sharing options...
Recommended Posts
Create an account or sign in to comment
You need to be a member in order to leave a comment
Create an account
Sign up for a new account in our community. It's easy!
Register a new accountSign in
Already have an account? Sign in here.
Sign In Now