MFCOM VBScript to create a report of Citrix Published Applications in Word

Link to Text File

'On Error Resume Next
'Formatting the current Date

strDate = pd(MONTH(date()),2) & "-" & _
pd(DAY(date()),2) & "-" & _
YEAR(Date())
'Create the Word document
Set objWord = CreateObject("Word.Application")
objWord.Visible = True
Set objDoc = objWord.Documents.Add()
Set objSelection = objWord.Selection
objDoc.Paragraphs.KeepTogether = True
Set mfFarm = CreateObject("MetaFrameCOM.MetaFrameFarm")
mfFarm.Initialize 1
strVBSLog = mfFarm.FarmName & " Published Applications Detailed Report " & strDate & ".doc"
'Type out the farm name.
objSelection.ParagraphFormat.Alignment = 1
objSelection.Font.Name = "Arial"
objSelection.Font.Size = "18"
objSelection.TypeText mfFarm.FarmName & " Applications Report"
objSelection.TypeParagraph()
objSelection.Font.Size = "14"
objSelection.TypeText "" & Date() & VbCrLf
objSelection.TypeParagraph()
anNumberOfApps = mfFarm.Applications.count
objSelection.TypeText "Total Number of Published Applications: " & anNumberOfApps
objSelection.TypeParagraph()
objSelection.Font.Size = "10"
objSelection.ParagraphFormat.Alignment = 0


'Build Application Properties
For Each mfApp In mfFarm.Applications
mfApp.LoadData 1
appusers = ""
appgroups = ""
appservers= ""
objSelection.InlineShapes.AddHorizontalLineStandard
If mfApp.AppType = 17 Then 'This is Published Content
Set appContentObj=mfApp.ContentObject
getusers()
getgroups()
applicationName()
distinguishedName()
contentAddress()
applicationUsers()
applicationGroups()
Else
Set aWinApp = mfApp.WinAppObject
getservers()
getusers()
getgroups()
If aWinApp.PNAttributes = 8 Then 'This is a Published Desktop
applicationName()
distinguishedName()
publishedDesktop()
applicationUsers()
applicationGroups()
applicationServers()
Else
applicationName()
distinguishedName()
applicationCommand()
applicationWorkingDir()
applicationUsers()
applicationGroups()
applicationServers()
End If
End if
Next

objSelection.ParagraphFormat.Alignment = 1
objSelection.Font.Name = "Arial"
objSelection.Font.Size = "18"
objSelection.TypeText mfFarm.FarmName & " Applications Report"
objSelection.TypeParagraph()
objSelection.Font.Size = "14"
objSelection.ParagraphFormat.Alignment = 0

'Save the doc, quit Word and clean up variables
objDoc.SaveAs strVBSLog

objDoc.Close
objWord.Quit

Set WshShell = Wscript.CreateObject("Wscript.Shell")
myDocspath=WshShell.RegRead("HKCU\Software\Microsoft\Windows\CurrentVersion\Explorer\Shell Folders\Personal")

wscript.echo "File has been saved to " & myDocspath & " as " & strVBSLog

Set objDoc = Nothing
Set objWord = Nothing

'Open the Document
Set wordApp = CreateObject("Word.Application")
wordApp.Documents.Open(myDocspath & "\" & strVBSLog)
wordApp.Visible = True

wscript.quit

'============================================================================================================================
'Subs and Functions
'============================================================================================================================
Function pd(n, totalDigits)
If totalDigits > len(n) then
pd = String(totalDigits-len(n),"0") & n
else
pd = n
End if
End Function

sub applicationName()

objSelection.Font.Size = "12"
objSelection.Font.Bold = True
objSelection.TypeText "Application Name: "
objSelection.Font.Bold = True
objSelection.TypeText vbTab & mfApp.AppName & VbCrLf
objSelection.TypeParagraph()
End sub

sub distinguishedName()
objSelection.Font.Size = "10"
objSelection.Font.Bold = True
objSelection.TypeText vbTab & "Distinguished Name: "
objSelection.Font.Bold = False
objSelection.TypeText vbTab & mfApp.DistinguishedName
objSelection.TypeParagraph()
End sub

sub contentAddress()
objSelection.Font.Size = "10"
objSelection.Font.Bold = True
objSelection.TypeText vbTab & "Command Line: "
objSelection.Font.Bold = False
objSelection.TypeText vbTab & appContentObj.Contentaddress
objSelection.TypeParagraph()
End sub

sub applicationUsers()
objSelection.Font.Size = "10"
objSelection.Font.Bold = True
objSelection.TypeText vbTab & "Users: "
objSelection.TypeParagraph()
objSelection.Font.Size = "10"
objSelection.Font.Bold = False
objSelection.TypeText appusers
objSelection.TypeParagraph()
End sub

sub applicationGroups()
objSelection.Font.Size = "10"
objSelection.Font.Bold = True
objSelection.TypeText vbTab & "Groups: "
objSelection.TypeParagraph()
objSelection.Font.Size = "10"
objSelection.Font.Bold = False
objSelection.TypeText appgroups
objSelection.TypeParagraph()
End sub

sub publishedDesktop()
objSelection.Font.Size = "10"
objSelection.Font.Bold = True
objSelection.TypeText vbTab & "Command Line: "
objSelection.Font.Bold = False
objSelection.TypeText " " & "Published Desktop"
objSelection.TypeParagraph()
End sub

sub applicationServers()
objSelection.Font.Size = "10"
objSelection.Font.Bold = True
objSelection.TypeText vbTab & "Servers: "
objSelection.TypeParagraph()
objSelection.Font.Size = "10"
objSelection.Font.Bold = False
objSelection.TypeText appservers
objSelection.InsertParagraphAfter()
End sub

sub applicationCommand()
objSelection.Font.Size = "10"
objSelection.Font.Bold = True
objSelection.TypeText vbTab & "Command Line: "
objSelection.Font.Bold = False
objSelection.TypeText vbTab & aWinApp.DefaultInitProg
objSelection.TypeParagraph()
End sub

sub applicationWorkingDir()
objSelection.Font.Size = "10"
objSelection.Font.Bold = True
objSelection.TypeText vbTab & "Working Directory: "
objSelection.Font.Bold = False
objSelection.TypeText vbTab & aWinApp.DefaultWorkDir
objSelection.TypeParagraph()
End sub

sub getusers()
anUserItems = mfApp.Users.count
If anUserItems = 0 then
appusers= vbTab & vbTab & "There are no Users associated with this Application" & VbCrLf
Else
For Each anUser In mfApp.Users
appusers= appusers & vbTab & vbTab & anUser.AAName & "\" & anUser.UserName & VbCrLf
Next
End if
End sub

sub getgroups()
anGroupsItems = mfApp.Groups.count
If anGroupsItems = 0 then
appgroups= vbTab & vbTab & "There are no Groups associated with this Application" & VbCrLf
Else
For Each anGroup In mfApp.Groups
appgroups= appgroups & vbTab & vbTab & anGroup.AAName & "\" & anGroup.GroupName & VbCrLf
Next
End if
End sub

sub getservers()
anServersItems = mfApp.Servers.count
If anServersItems = 0 then
appservers= vbTab & vbTab & "There are no Servers associated with this Application" & VbCrLf
Else
For Each anServer In mfApp.Servers
appservers= appservers & vbTab & vbTab & anServer.ServerName & VbCrLf
Next
End if
End sub