Open current wallpaper in windows8

open_current_wallpaper_windows.vbs

Set Shell = CreateObject("WScript.Shell")

' change to TranscodedImageCache_001 for second monitor and so on
openWallpaper("HKCU\Control Panel\Desktop\TranscodedImageCache_000")

function openWallpaper(regKey) 
  arr = Shell.RegRead(regKey)
  a=arr
  fullPath = ""
  consequtiveZeroes = 0

  For I = 24 To Ubound(arr)
    if consequtiveZeroes > 1 then
      exit for
    end if

    a(I) = Cint(arr(I))

    if a(I) > 1 then
      fullPath = fullPath & Chr(a(I))
      consequtiveZeroes = 0
    else
      consequtiveZeroes = consequtiveZeroes + 1
    end if
  Next

  Shell.run Chr(34) & fullPath & Chr(34)
end function

Wscript.Quit

Can't seem to make it work on my Win 8.1 ... I'm on a single Monitor setup.. I tried to remove the _000 too but still not working..

Would you mind contacting me to figure out the culprit ?

This is great.
The only change I had to make was to add quotes around the final path in case it has spaces:

Shell.run Chr(34) & fullPath & Chr(34)

Thanks, works great on Win10 with replacing latest final path as TimSirmovics suggested.

Added TimSirmovics' suggestion :)

Привет подскажите скрипт не работает без паузы
Shell.run Chr(34) & fullPath & Chr(34)
end function
pause
и ошибка строка 28 сим2

вот
Set Shell = CreateObject("WScript.Shell")

' change to TranscodedImageCache_001 for second monitor and so on
openWallpaper("HKCU\Control Panel\Desktop\TranscodedImageCache_001")

function openWallpaper(regKey)
arr = Shell.RegRead(regKey)
a=arr
fullPath = ""
consequtiveZeroes = 0

For I = 24 To Ubound(arr)
if consequtiveZeroes > 1 then
exit for
end if

a(I) = Cint(arr(I))

if a(I) > 1 then
  fullPath = fullPath & Chr(a(I))
  consequtiveZeroes = 0
else
  consequtiveZeroes = consequtiveZeroes + 1
end if

Next

Shell.run Chr(34) & fullPath & Chr(34)

end function
pause
Wscript.Quit
так работает но ошибка и ошибка строка 28 сим2

privet, @fedsumk I don't use the vbs solution anymore, and implemented this in Autohotkey:

https://gist.github.com/raveren/bac5196d2063665d2154#file-aio-ahk-L240

however it only supports two monitors side by side.

This does not support files with unicode in their path (or at least their file name) and I was unable to modify it to support it as I couldn't find a way to convert it to unicode (I saw someone say VBS doesn't support unicode). So I made my own script to do the same thing in PowerShell.

$regKey = $Args[0]
$regEntry = Get-ItemProperty -Path "HKCU:\Control Panel\Desktop" -Name $regKey
$filePathBytes = $regEntry.$regKey
$decodedFilePathDirty = [System.Text.Encoding]::Unicode.GetString($filePathBytes)
$decodedFilePath = $decodedFilePathDirty.Substring(12)
$decodedFilePath = $decodedFilePath.Substring(0, $decodedFilePath.IndexOf('\\?'))
start $decodedFilePath

And I have a batch file for each monitor to execute it with a different parameter.

powershell.exe -command "& '.\CurrentDesktopWallpaper.ps1' TranscodedImageCache_000"

Please fix line #27:

Change:

Shell.run Shell.run Chr(34) & fullPath & Chr(34)

To:

Shell.run Chr(34) & fullPath & Chr(34)

I'm sorry I am not supporting it anymore, please fork it!

And it's irresponsible of me to just add untested code - I know this current version worked for me some time ago...

//I know this current version worked for me some time ago...//

No. It won't. "Shell.run" is repeated, which throws the error 800A0401.

Please compare the current script with the older version of the script.

okay, makes sense, thank you!

Please feel free to use my slightly different wallpaper script. This one opens the folder and highlights the image.

Const HKCU = &H80000001 'HKEY_CURRENT_USER

Set oReg=GetObject("winmgmts:{impersonationLevel=impersonate}!\\" _
            & ".\root\default:StdRegProv")

sKeyPath = "Control Panel\Desktop\"
sValueName = "TranscodedImageCache"
oReg.GetBinaryValue HKCU, sKeyPath, sValueName, sValue

sContents = ""

For i = 24 To UBound(sValue)
  if sValue(i) = 0 and sValue(i+1) = 0 then exit for
  sByte = sValue(i)+sValue(i+1)*256
  sContents = sContents & ChrW(sByte)
  i=i+1
next
CreateObject("Wscript.Shell").Run "explorer.exe /select, """ & sContents & """"

Please feel free to use my slightly different wallpaper script. This one opens the folder and highlights the image.

What are the odds this was exactly what i was looking for and you just posted it 19 days ago?

Thank you!

Please feel free to use my slightly different wallpaper script. This one opens the folder and highlights the image.

What are the odds this was exactly what i was looking for and you just posted it 19 days ago?

Thank you!

The odds are 100%. :)

Same line of thought reused in this Autohotkey script:

https://gist.github.com/raveren/bac5196d2063665d2154

look for WIN+W