Copy Image File Based On Screen Resolution

How to copy image file based on screen resolution.

dim filesys
set filesys=CreateObject(“Scripting.FileSystemObject”)
Set objSh = CreateObject(“Wscript.Shell”)

ScreenRes = funcScreenResolution()
Function funcScreenResolution()
Set objIE = CreateObject(“InternetExplorer.Application”)
objIE.Navigate(“about:blank”)
Do Until objIE.readyState = 4: Loop
width = objIE.document.ParentWindow.screen.width
height = objIE.document.ParentWindow.screen.height
objIE.Quit
funcScreenResolution = array(width,height)
End Function

strResolution = ScreenRes(0) & ” x ” & ScreenRes(1)

Select Case strResolution
Case “800 x 600”
strWallpaperPath = “C:\Temp\Source\800×600.jpg”
Case “1024 x 768”
strWallpaperPath = “C:\Temp\Source\1024×768.jpg”
Case “1152 x 864”
strWallpaperPath = “C:\Temp\Source\1152×864.jpg”
Case “1280 x 768”
strWallpaperPath = “C:\Temp\Source\1280×768.jpg”
Case “1280 x 800”
strWallpaperPath = “C:\Temp\Source\1280×800.jpg”
Case “1280 x 1024”
strWallpaperPath = “C:\Temp\Source\1280×1024.jpg”
Case “1366 x 768”
strWallpaperPath = “C:\Temp\Source\1366×768.jpg”
Case “1440 x 900”
strWallpaperPath = “C:\Temp\Source\1440×900.jpg”
Case “1680 x 1050”
strWallpaperPath = “C:\Temp\Source\1680×1050.jpg”
Case “1920 x 1080”
strWallpaperPath = “C:\Temp\Source\1920×1080.jpg”
Case “1920 x 1440”
strWallpaperPath = “C:\Temp\Source\1920×1440.jpg”
Case Else
End Select

filesys.CopyFile strWallpaperPath, “C:\Temp\Dest”

email me