On Error Resume Next

Dim objSWbemServices
Dim objSWbemLocator
Dim PackageName
Dim ProgramName
Dim CollectionName
Dim AdName
Dim PackageFound
Dim ProgramFound
Dim CollectionFound
Dim CollectionID
Dim AdvertisementFound
Dim Advertisement
Dim Advertisements
Dim Package
Dim Packages
Dim objCollections
Dim colCollections
Dim newAdvertisement


PackageName	= "Dog"
ProgramName	= "Spot"
CollectionName = "All Users"
AdName		 = "Spots Advertisement"

'Connect to provider namespace for local computer.
Set objSWbemLocator = CreateObject("WbemScripting.SWbemLocator")

Set objSWbemServices= objSWbemLocator.ConnectServer(".", "root\sms")

Set ProviderLoc = objSWbemServices.InstancesOf("SMS_ProviderLocation")

For Each Location In ProviderLoc
		If Location.ProviderForLocalSite = True Then
			Set objSWbemServices = objSWbemLocator.ConnectServer _
				 (Location.Machine, "root\sms\site_" + Location.SiteCode)
		 End If
Next

PackageFound=False
ProgramFound=False
CollectionFound=False
AdvertisementFound=False

Set Packages = objSWbemServices.ExecQuery("Select * From SMS_Package Where Name='" & PackageName & "'")
For Each Package In Packages
	PackageFound=True
	PackageID=Package.PackageID
	objSWbemServices.Get("SMS_Program.PackageID='" & PackageID &"',ProgramName='" & ProgramName & "'")
	If Err=0 Then
		ProgramFound=True
	Else
		Wscript.Quit
	End If
Next

Set colCollections = objSWbemServices.ExecQuery("Select * From SMS_Collection")
For Each objCollection In colCollections
	If objCollection.Name=CollectionName Then
		CollectionFound=True
		CollectionID=objCollection.CollectionID
   End If
Next
Set Advertisements = objSWbemServices.ExecQuery("Select * From SMS_Advertisement")
For Each Advertisement In Advertisements
	If Advertisement.AdvertisementName=AdName Then
		WScript.Echo "Duplicate Advertisement name, but that is allowed"		
		AdvertisementFound=True
	End If
Next
If Not (PackageFound AND ProgramFound AND CollectionFound) Then
	WScript.Echo "Either the package, program, or collection names were not found"
	WScript.Echo "so the ad cannot be created"
	Else
	WScript.Echo "Creating advertisement: " & AdName
	'Create a value for the time when the ad should 
	'be available to users.
	formattedmonth= month(now)
	If len(formattedmonth)=1 Then formattedmonth = "0" & formattedmonth
	formattedday= day(now)
	If len(formattedday)=1 Then formattedday = "0" & formattedday
	datetime = year(now) & formattedmonth & formattedday & left(formatdatetime(now, 4),2) & right(formatdatetime(now, 4),2) & "00.000000+***"	 'create a value for the time when the ad should expire.
'Default to + 1/2 year, but it's not enabled.
	formattedmonth= month(DateAdd( "d",182, now))
	If len(formattedmonth)=1 Then formattedmonth = "0" & formattedmonth
	formattedday= day(DateAdd( "d",182, now))
	If len(formattedday)=1 Then formattedday = "0" & formattedday
	expdatetime = year(DateAdd( "d",182, now)) & formattedmonth & formattedday & left(formatdatetime(DateAdd( "d",182, now), 4),2) & right(formatdatetime(DateAdd( "d",182, now), 4),2) & "00.000000+***"

Set newAdvertisement = objSWbemServices.Get("SMS_Advertisement").SpawnInstance_()
	newAdvertisement.AdvertisementName = AdName
	newAdvertisement.comment = "created by NewAd.vbs"	 
	newAdvertisement.CollectionID = CollectionID
	newAdvertisement.PackageID = PackageID
	newAdvertisement.ProgramName = ProgramName
	newAdvertisement.PresentTime=datetime
	newAdvertisement.ExpirationTime= expdatetime
	newAdvertisement.Put_
End If