VBScript: Run Optional SCCM Advertisements

Here’s a fairly simple script that will check for and execute all optional advertisments on a client machine. This could be modified to include checks for adverts that have already ran and not rerun or put a GUI around it to choose which adverts to run selectively.
If the code has not been downloaded to the client yet a content retrieval will be made automatically prior to running.

CAREFUL OF WORD WRAPPING

'==========================================================================
'
' VBScript Source File -- Created with SAPIEN Technologies PrimalScript 2009
'
' NAME: RunOptionalAdvertisements.vbs
'
' AUTHOR: William Bracken
' DATE : 10/12/2009
'
' COMMENT: Run optional advertisments
'
'==========================================================================
Dim oUIResource, programArray(), fs, f
Dim oPrograms, x, i, strLogFile, strFileName, UserTempPath, WindowsTempPath
Dim oProgram, programId, packageId, myProgram, WinTempLog, UsrTempLog
Const ForReading = 1, TemporaryFolder = 2, ForAppending = 8
Set fs = CreateObject("Scripting.FileSystemObject")
Set WSHShell = CreateObject("WScript.Shell")
windir = WSHShell.ExpandEnvironmentStrings("%WINDIR%")
UserTempPath = WSHShell.ExpandEnvironmentStrings("%TEMP%")
WindowsTempPath = windir & "\temp"
strFileName = "RunOptionalAdverts.log"
WinTempLog = WindowsTempPath & "\" & strFileName
UsrTempLog = UserTempPath & "\"& strFileName
strLogFile = UsrTempLog

CLEANLOG strLogFile
COLLECTMSG "Begin Logging", ""

' Validate connection to SCCM Client
Set oUIResource = CreateObject ("UIResource.UIResourceMgr")
If oUIResource Is Nothing Then
COLLECTMSG "CONNECT TO SCCM CLIENT", "Could not create Resource Object - quitting"
wscript.echo "Could not create Resource Object - quitting"
WScript.Quit
End If

'==========================================================================
' Begin Process
'==========================================================================
' Call ShowPrograms routine to get array of programs available
ShowPrograms

' Split Array And Call Sub to install
For Each program In programArray
strStrings = Split (program,";")
programId = strStrings(0)
packageId = strStrings(1)
' Call RunProgam routine to invoke installation
'RunProgram programId,packageId
Next

' Cleanup
Set oProgram=Nothing
Set oUIResource=Nothing

'==========================================================================
' Routines
'==========================================================================
Sub ShowPrograms
On Error Resume Next

Set oPrograms = oUIResource.GetAvailableApplications

If oPrograms Is Nothing Then
COLLECTMSG "SHOWPROGRAMS", "Failed to get programs object - quitting"
wscript.echo "Failed to get programs object - quitting"
Set oUIResource=Nothing
Exit Sub
End If
strCount = oPrograms.Count
COLLECTMSG "SHOWPROGRAMS", "There are " & strCount & " programs"
wscript.echo "There are " & strCount & " programs"
wscript.echo
strCount = strCount - 1

ReDim programArray(strCount)
x = 0
For Each oProgram In oPrograms
COLLECTMSG "SHOWPROGRAMS", "ProgramName:" & oProgram.Name & ";" & "PackageID:" & oProgram.PackageId
WScript.Echo "Program Name: " & oProgram.Name
WScript.Echo " Package ID: " & oProgram.PackageId
' build array
programArray(x) = oProgram.Name & ";" & oProgram.packageId
x = x + 1
Next
End Sub

Sub RunProgram(programId,packageId)
On Error Resume Next
' #region Disabled code
' if oUIResourceMgr.IsMandatoryProgramPending = 1 Then
' Wscript.Echo "Mandatory program pending. Try again later."
' Set oUIResource=Nothing
' Exit Sub
' End If
' #endregion

' Get Program object
Set oProgram = oUIResource.GetProgram(programId,packageId)
'WScript.Echo "oProgram: " & oProgram.Name
if oProgram is Nothing Then
COLLECTMSG "RUNPROGRAMS", "Couldn't get the program"
WScript.Echo "Couldn't get the program"
Set oUIResource=Nothing
Exit Sub
End If

'When was the program last ran?
Set myProgram = oUIResource.GetProgram(programId, packageId)
oldTime = myProgram.LastRunTime
COLLECTMSG "RUNPROGRAMS", "Last Run Time: " & oldTime
WScript.Echo oldTime

' Execute program
COLLECTMSG "RUNPROGRAMS", "Running program: " & programId & " " & packageId
Wscript.Echo "Running program: " & programId & " " & packageId
oUIResource.ExecuteProgram programId, packageId, True

' Wait for last ran to change...
Set myProgram = oUIResource.GetProgram(programId, packageId)
Do While myProgram.LastRunTime = oldTime
Wscript.Sleep(2500)
Set myProgram = oUIResource.GetProgram(programId, packageId)
Loop
COLLECTMSG "RUNPROGRAMS", "Return Code: " & Err
WScript.Echo "Return Code: " & Err
End Sub

'*************************************************************
'*** Method: COLLECTMSG
'*** Description: Collections Errors for logging to log file
'*************************************************************
Sub COLLECTMSG(szLocation, errmsg)
'on error resume next
'Dim f
strmsg=errmsg
Set f = fs.OpenTextFile(strLogFile, ForAppending, True)
strmsg = Now & " | " & szLocation & " | "& errmsg
if err0 then
strmsg=strmsg & vbCrLf _
& "Error | " & Hex(Err.Number) & " h (" & CStr(Err.Number) & ") | Description |" & Err.Description
end if
f.Writeline strmsg
f.Close
strmsg=""
Err.Clear
End Sub

Sub CLEANLOG(strLogFile)
If fs.FileExists(strLogFile) Then
fs.DeleteFile strLogFile
End If
End Sub

Advertisements

One thought on “VBScript: Run Optional SCCM Advertisements

  1. This works great, thanks a lot!

Leave a Reply

Fill in your details below or click an icon to log in:

WordPress.com Logo

You are commenting using your WordPress.com account. Log Out / Change )

Twitter picture

You are commenting using your Twitter account. Log Out / Change )

Facebook photo

You are commenting using your Facebook account. Log Out / Change )

Google+ photo

You are commenting using your Google+ account. Log Out / Change )

Connecting to %s