Windows 10 automatically downloads and displays beautiful images on your lock screen, but offers no obvious way to set them as wallpaper. This script tries to help by copying the current set of downloaded images to a folder on your desktop and doing some sorting for you.
You have to create the target folder on your desktop manually first as a sort of sanity check. By default it needs to be named 'spotlight exported'. Then run spotlight.vbs.
spotlight.vbs:
'************************************
'* *
'* find and copy spotlight images *
'* *
'************************************
'Important:
'You have to create this folder on your desktop:
strImageFolderName = "spotlight exported"
'****************************
'****************************
' Do stuff
'****************************
Const imgError = 0
Const imgLandscape = 1
Const imgPortrait = 2
Const imgSquare = 3
strDebug = ""
Set objShell = CreateObject("WScript.Shell")
strSrcFolder = objShell.ExpandEnvironmentStrings("%localappdata%") & "\Packages\Microsoft.Windows.ContentDeliveryManager_cw5n1h2txyewy\LocalState\Assets"
strImgFolder = objShell.SpecialFolders("Desktop") & "\" & strImageFolderName
Set objFSO = CreateObject("Scripting.FileSystemObject")
If objFSO.FolderExists(strSrcFolder) Then
If objFSO.FolderExists(strImgFolder) Then
msgres = MsgBox ("This script will copy files to '" & strImgFolder & "'." & vbNewLine & "Do you want to continue?", vbYesNo, "Spotlight Image Copy Script")
if msgres = vbYes then CopyStuff() else Wscript.Echo ("Quitting...")
Else
Wscript.Echo "Image folder does not exist " & vbNewLine & strImgFolder
end if
Else
Wscript.Echo "Source folder does not exist" & vbNewLine & strSrcFolder
End If
'****************************
' subroutine
' to copy stuff if all is well
'****************************
Sub CopyStuff()
Set objFolder = objFSO.GetFolder(strSrcFolder)
Set colFiles = objFolder.Files
iCopied = 0
iFailed = 0
iSkipped = 0
iTotal = 0
iLandscape = 0
iPortrait = 0
strDebug = ""
CreateFolders
For Each objFile in colFiles
On Error Resume Next
if objFile.size < 100000 then bTooSmall = true else bTooSmall = false
orientation = getOrientation (objFSO.GetAbsolutePathName(objFile))
if orientation = imgPortrait then iPortrait = iPortrait + 1
if orientation = imgLandscape then iLandscape = iLandscape + 1
if bTooSmall = false then
if copyFileSorted (objFile, strImgFolder, orientation) <> true then iFailed = iFailed + 1 else iCopied = iCopied + 1
else
iSkipped = iSkipped + 1
End If
iTotal = iTotal + 1
Next
MsgBox "Copied " & iCopied & " file(s)." & vbNewLine & vbNewLine & "Skipped: " & iSkipped & vbNewLine & "Failed: " & iFailed & _
vbNewLine & vbNewLine & "Portrait: " & iPortrait & ", Landscape: " & iLandscape & _
vbNewLine & vbNewLine & "Processed " & iTotal & " file(s) in total.", , "Processing finished"
End Sub
sub CreateFolders()
If not objFSO.FolderExists(strImgFolder & "\Landscape") Then
objFSO.CreateFolder strImgFolder & "\Landscape"
end if
If not objFSO.FolderExists(strImgFolder & "\Portrait") Then
objFSO.CreateFolder strImgFolder & "\Portrait"
end if
end sub
function getOrientation(filepath)
on error resume next
Err.Clear
Set objImage = CreateObject("WIA.ImageFile")
objImage.LoadFile filepath
If objImage.Width > objImage.Height Then
getOrientation = imgLandscape
elseif objImage.Width < objImage.Height then
getOrientation = imgPortrait
else
getOrientation = imgSquare
End If
If Err.Number <> 0 Then getOrientation = imgError
Err.Clear
end function
function copyFileSorted(objFile, destFolder, orientation)
dest2 = destFolder
if orientation = imgLandscape then dest2 = dest2 & "\Landscape"
if orientation = imgPortrait then dest2 = dest2 & "\Portrait"
Err.Clear
objFSO.copyFile objFSO.GetAbsolutePathName(objFile), dest2 & "\" & objFile.Name & ".jpg", false
If Err.Number <> 0 Then
copyFileSorted = false
Err.Clear
else
copyFileSorted = true
End If
strDebug = strDebug & dest2 & " " & orientation & ", "
end function
No comments:
Post a Comment