' NAME: FilesOnDesktop.vbs
'
' AUTHOR: Alan Kaplan , alan dot akaplan at va dot gov
' DATE : 1/26/2007
'
' COMMENT: Warns users that files on desktop are not backed up.
' v 1.1 adds path and computername for help desk.
'==========================================================================
Option Explicit
dim wshShell
Set wshShell = WScript.CreateObject("WScript.Shell")
Dim strIgnore, strDesktop, message
Dim iCount
'note this Is a String listing of extensions, Not an Array
'The list is not required
strIgnore = "LNK,URL,INI,PIF,INF,HISTORY"
'if you leave in URLs, internet shortcuts are noted
'strIgnore = "LNK,INI,PIF,INF"
strDesktop = wshShell.ExpandEnvironmentStrings("%USERPROFILE%"&"\Desktop")
iCount = 0
dim fso
Set fso = CreateObject("Scripting.FileSystemObject")
message = "If your hard drive crashes, or this computer is replaced, " & _
"you will lose these files found on your desktop:" & VbCrLf
check strDesktop
message = message & VbCrLf & VbCrLf & _
"Copy these files, internet shortcuts and any other files that you may have stored on this computer to your " & _
"network home directory now to avoid possible data loss!" & _
" If you need assistance, please call the Help Desk. Your desktop path is " & strDesktop & _
" on " & wshShell.ExpandEnvironmentStrings("%COMPUTERNAME%") & "." & VbCrLf
if iCount > 1 Then
IEMessage Message,"DATA LOSS WARNING!","lt Blue",600,750,True
End If
'================ Functions and Subs ==============
Sub check (fldname)
iCount = iCount + 1
'On Error Resume Next
Dim subfolders,files,folder,file,fldr,ofiles,strExt,strFMessage, strFileName
Set fldr = fso.GetFolder(fldname)
Set subfolders = fldr.SubFolders
Set ofiles = fldr.Files
If iCount = 1 Then
strFMessage = "On Desktop"
Else
strFMessage = "In desktop folder "
End If
'Display the path and all of the folders.
message = message & VbCrLf & strFMessage & mid(fldr.Path,Len(strDesktop)+2) & ":" & VbCrLf
'Display all of the files.
For Each file in ofiles
strExt = ucase(fso.GetExtensionName(file.name))
If InStr(strIgnore,strExt) = 0 Then
iCount = iCount + 1
strFileName = file.name
If strExt = "URL" Then
strFileName = "[Internet Shortcut] " & strFileName
End If
message = message & string(5,"-")& "> " & strFileName & VbCrLf
End If
Next
'Recurse all of the subfolders.
For Each folder in subfolders
check folder
Next
Set subfolders = Nothing
Set files = Nothing
End Sub
Sub IEMessage(message,strTitle,strBGColor,iHeight,IWidth,bPrint)
Dim oIE, oPage
Dim strComputer, strBorder, strFont
Dim strFormatOn, strFormatOff, iTSView
Set oIE = CreateObject("InternetExplorer.Application")
iTSview = 0 '1 for troubleshooting, allows view source menu
strBorder = 1 'Best appearance is strBorder 1
strFont = "Arial"
oIE.Navigate "about:blank"
oIE.AddressBar = False
oIE.Height = iHeight
oIE.Width = IWidth
oIE.MenuBar = iTSView
oIE.ToolBar = iTSView
oIE.StatusBar = False
oIE.Left = 150
oIE.Top = 50
oIE.Visible = 1
message = Replace(message,vbcrlf," "& vbcrlf)
Do While (oIE.Busy)
Wscript.Sleep 250
Loop
Set oPage = oIE.Document
oPage.Open
oPage.Writeln "" & strTitle & ""
oPage.Writeln ""
oPage.Writeln ""
oPage.Writeln "
" & strTitle & "
"
oPage.Writeln "" & Message & " "
If bPrint Then
oPage.WriteLn ""
End If
oPage.Writeln ""
oPage.Write()
oPage.Close
End Sub