• Status: Solved
  • Priority: Medium
  • Security: Public
  • Views: 1402
  • Last Modified:

Script that saves Xml files of a GPO to word file. A addition to do the same to multiple files in one shot.

Hi,

Script that saves Xml files of a GPO to word file. A addition to do the same to multiple files in one shot.
I have 100's of GPO's that i need to convert to word. Can anyone help on this.\

Regards
sharath
set xmlDoc=CreateObject("Microsoft.XMLDOM") 
Set objWord = CreateObject("Word.Application") 
Set objDoc = objWord.Documents.Add() 
Set objSelection = objWord.Selection 
 
'This is the actual name of the XML document minus the path and the ".XML" extension, it becomes the word doc header 
xmlfile = "Default Domain Policy"
 
objSelection.Font.Name = "Arial" 
objSelection.Font.Size = "18" 
objSelection.Font.Bold = True 
objSelection.TypeText xmlfile & VbCrLf 
 
objSelection.Font.Bold = False 
objSelection.Font.Size = "10" 
 
xmlDoc.async="false" 
xmlDoc.load("C:\GPOXML\" & xmlfile &".xml")
'objDoc.SaveAs("C:\GPOXML\" & xmlfile & ".doc")
for each x in xmlDoc.documentElement.childNodes 
        If x.nodename = "Computer" or x.nodename = "User" Then 
                For Each y In x.childnodes 
                        if y.Nodename = "ExtensionData" then 
                                For Each z In y.childnodes 
                                        If z.Nodename = "Extension" Then 
                                                For Each setting In z.childnodes 
                                                        objSelection.TypeText "______________________________________" & vbCr 
                                                        DocumentPolicy(Setting) 
                                                Next 
                                        End if 
                                Next 
                        End if 
                Next 
        End If 
Next 
 
objDoc.SaveAs("C:\GPOXML\" & xmlfile & ".doc") 
objWord.visible = True 
 
Function DocumentPolicy(Setting) 
        'this function basically cleans up the headers of the word document, so they are more human readable 
        Select Case setting.nodename 
                Case "q1:Policy" 
                        replacestr = "q1:" 
                Case "q1:DropDownList" 
                        replacestr = "q1:" 
                Case "q1:Name" 
                        replacestr = "q1:" 
                Case "q1:Value" 
                        replacestr = "q1:" 
                Case "q1:State" 
                        replacestr = "q1:" 
                Case "q2:Audit" 
                        replacestr = "q2:" 
                Case "q2:SecurityOptions" 
                        replacestr = "q2:" 
                Case "q2:EventLog" 
                        replacestr = "q2:" 
                Case "q2:RestrictedGroups" 
                        replacestr = "q2:" 
                Case "q2:File" 
                        replacestr = "q2:" 
                Case "q2:Display" 
                        replacestr = "q2:" 
                Case "q3:General" 
                        replacestr = "q3:" 
                Case "q3:HashRule" 
                        replacestr = "q3:" 
                Case "q3:PathRule" 
                        replacestr = "q3:" 
                Case "q3:InternetZoneRule" 
                        replacestr = "q3:" 
                Case "q4:AutoEnrollmentSettings" 
                        replacestr = "q4:" 
                Case "q4:AutoEnrollmentSettings" 
                        replacestr = "q4:" 
                Case "q4:RootCertificateSettings" 
                        replacestr = "q4:" 
                Case "q4:EFSSettings" 
                        replacestr = "q4:" 
                Case "q5:PreferenceMode" 
                        replacestr = "q5:" 
                Case "q2:PreferenceMode" 
                        replacestr = "q2:" 
                Case "q2:ProxySettings" 
                        replacestr = "q2:" 
                Case "q2:UseSameProxy:" 
                        replacestr = "q2:" 
                Case "q2:HTTP:" 
                        replacestr = "q2:" 
                Case "q2:NoProxyIntranet:" 
                        replacestr = "q2:" 
        End Select 
        objSelection.Font.Bold = True 
        objSelection.TypeText VbCrLf & replace(setting.nodename, replacestr,"") & VbCrLf 
        objSelection.Font.Bold = False 
        For Each Value In Setting.Childnodes 
                NodeName = replace(Value.nodename,replacestr,"") 
                If NodeName = "Explain" Then 
                        objSelection.Font.Bold = True 
                        objSelection.TypeText Nodename & ": " & vbcrlf 
                        objSelection.Font.Bold = False 
                        objSelection.TypeText vbTab & replace(value.text,"\n\n", VbCrLf & VbCrLf & vbTab )& vbcrlf 
                Else 
                        objSelection.Font.Bold = True 
                        objSelection.TypeText Nodename & ": " 
                        objSelection.Font.Bold = False 
                        objSelection.TypeText vbtab & value.text & vbcrlf 
                End if 
        Next 
        If isnull(Setting.childnodes) Then 
                For Each node In Setting.childnodes 
                        DocumentPolicy(node) 
                next 
        End if 
        objSelection.TypeText VbCrLf 
End Function 
 
'Now, when you run this script against your export there may be some XML tags I  
'didn’t notice because a setting you set is one I didn’t set. Any time you see  
'them in the document you can add a new Case statement in the select case followed  
'by setting the replacestr to the string you want to replace with a null. The  
'lines I’m talking about look similar to this: 
'Case "q2:xxxxxxxx" 
'replacestr = "q2:" 
 
wscript.echo "Done"

Open in new window

0
bsharath
Asked:
bsharath
  • 14
  • 8
1 Solution
 
RobSampsonCommented:
Sharath, this should go through each XML file in strFolder and save them as DOC.

Regards,

Rob.
Set objFSO = CreateObject("Scripting.FileSystemObject")
Set xmlDoc = CreateObject("Microsoft.XMLDOM")
Set objWord = CreateObject("Word.Application")  

'This will go through each XML file in the following folder
strFolder = "C:\GPOXML\"
If Right(strFolder, 1) <> "\" Then strFolder = strFolder & "\"

For Each objFile In objFSO.GetFolder(strFolder).Files
	If Left(LCase(objFile.Name), 4) = ".xml" Then
		'This is the actual name of the XML document minus the path and the ".XML" extension, it becomes the word doc header  
		xmlfile = Left(objFile.Name, Len(objFile.Name) - 4)
		  
		Set objDoc = objWord.Documents.Add()  
		Set objSelection = objWord.Selection  
		objSelection.Font.Name = "Arial"  
		objSelection.Font.Size = "18"  
		objSelection.Font.Bold = True  
		objSelection.TypeText xmlfile & VbCrLf  
		  
		objSelection.Font.Bold = False  
		objSelection.Font.Size = "10"  
		  
		xmlDoc.async="false"  
		xmlDoc.load(strFolder & xmlfile & ".doc")
		'objDoc.SaveAs("C:\GPOXML\" & xmlfile & ".doc") 
		for each x in xmlDoc.documentElement.childNodes  
		        If x.nodename = "Computer" or x.nodename = "User" Then  
		                For Each y In x.childnodes  
		                        if y.Nodename = "ExtensionData" then  
		                                For Each z In y.childnodes  
		                                        If z.Nodename = "Extension" Then  
		                                                For Each setting In z.childnodes  
		                                                        objSelection.TypeText "______________________________________" & vbCr  
		                                                        DocumentPolicy(Setting)  
		                                                Next  
		                                        End if  
		                                Next  
		                        End if  
		                Next  
		        End If  
		Next  
		  
		objDoc.SaveAs(strFolder & xmlfile & ".doc")
		objDoc.Close False
	End If
Next

objWord.Quit
  
'Now, when you run this script against your export there may be some XML tags I   
'didn’t notice because a setting you set is one I didn’t set. Any time you see   
'them in the document you can add a new Case statement in the select case followed   
'by setting the replacestr to the string you want to replace with a null. The   
'lines I’m talking about look similar to this:  
'Case "q2:xxxxxxxx"  
'replacestr = "q2:"  
  
wscript.echo "Done"

Function DocumentPolicy(Setting)
        'this function basically cleans up the headers of the word document, so they are more human readable  
        Select Case setting.nodename  
                Case "q1:Policy"  
                        replacestr = "q1:"  
                Case "q1:DropDownList"  
                        replacestr = "q1:"  
                Case "q1:Name"  
                        replacestr = "q1:"  
                Case "q1:Value"  
                        replacestr = "q1:"  
                Case "q1:State"  
                        replacestr = "q1:"  
                Case "q2:Audit"  
                        replacestr = "q2:"  
                Case "q2:SecurityOptions"  
                        replacestr = "q2:"  
                Case "q2:EventLog"  
                        replacestr = "q2:"  
                Case "q2:RestrictedGroups"  
                        replacestr = "q2:"  
                Case "q2:File"  
                        replacestr = "q2:"  
                Case "q2:Display"  
                        replacestr = "q2:"  
                Case "q3:General"  
                        replacestr = "q3:"  
                Case "q3:HashRule"  
                        replacestr = "q3:"  
                Case "q3:PathRule"  
                        replacestr = "q3:"  
                Case "q3:InternetZoneRule"  
                        replacestr = "q3:"  
                Case "q4:AutoEnrollmentSettings"  
                        replacestr = "q4:"  
                Case "q4:AutoEnrollmentSettings"  
                        replacestr = "q4:"  
                Case "q4:RootCertificateSettings"  
                        replacestr = "q4:"  
                Case "q4:EFSSettings"  
                        replacestr = "q4:"  
                Case "q5:PreferenceMode"  
                        replacestr = "q5:"  
                Case "q2:PreferenceMode"  
                        replacestr = "q2:"  
                Case "q2:ProxySettings"  
                        replacestr = "q2:"  
                Case "q2:UseSameProxy:"  
                        replacestr = "q2:"  
                Case "q2:HTTP:"  
                        replacestr = "q2:"  
                Case "q2:NoProxyIntranet:"  
                        replacestr = "q2:"  
        End Select  
        objSelection.Font.Bold = True  
        objSelection.TypeText VbCrLf & replace(setting.nodename, replacestr,"") & VbCrLf  
        objSelection.Font.Bold = False  
        For Each Value In Setting.Childnodes  
                NodeName = replace(Value.nodename,replacestr,"")  
                If NodeName = "Explain" Then  
                        objSelection.Font.Bold = True  
                        objSelection.TypeText Nodename & ": " & vbcrlf  
                        objSelection.Font.Bold = False  
                        objSelection.TypeText vbTab & replace(value.text,"\n\n", VbCrLf & VbCrLf & vbTab )& vbcrlf  
                Else  
                        objSelection.Font.Bold = True  
                        objSelection.TypeText Nodename & ": "  
                        objSelection.Font.Bold = False  
                        objSelection.TypeText vbtab & value.text & vbcrlf  
                End if  
        Next  
        If isnull(Setting.childnodes) Then  
                For Each node In Setting.childnodes  
                        DocumentPolicy(node)  
                next  
        End if  
        objSelection.TypeText VbCrLf  
End Function

Open in new window

0
 
bsharathAuthor Commented:
Thanks so much Rob..

I have 2 xml files in the folder.
When run i get the Done box. Where does the word files get stored
0
 
RobSampsonCommented:
The Word files should get stored in the same folder with a .DOC extension.

Did you see Microsoft Word open up to process each XML?  If not, under this line:
Set objWord = CreateObject("Word.Application")  

add
objWord.Visible = True

Rob.
0
Free tool for managing users' photos in Office 365

Easily upload multiple users’ photos to Office 365. Manage them with an intuitive GUI and use handy built-in cropping and resizing options. Link photos with users based on Azure AD attributes. Free tool!

 
bsharathAuthor Commented:
I added this
objWord.Visible = True
now i could just see a glance of word and it closes in a sec
but does not save it in the folder
0
 
RobSampsonCommented:
Oh. LOL! My mistake, please change this line
      If Left(LCase(objFile.Name), 4) = ".xml" Then


to this
      If Right(LCase(objFile.Name), 4) = ".xml" Then


I was checking if the "left" four characters of the file name were .xml, not the "right" four characters!

Regards,

Rob.
0
 
bsharathAuthor Commented:
Rob i get this now

---------------------------
Windows Script Host
---------------------------
Script:      C:\GPOXML.vbs
Line:      27
Char:      3
Error:      Object required: 'xmlDoc.documentElement'
Code:      800A01A8
Source:       Microsoft VBScript runtime error

---------------------------
OK  
---------------------------
0
 
RobSampsonCommented:
Hmmm, I wonder if that document does not have any child nodes....does this work?

Rob.
Set objFSO = CreateObject("Scripting.FileSystemObject")
Set xmlDoc = CreateObject("Microsoft.XMLDOM")
Set objWord = CreateObject("Word.Application")  

'This will go through each XML file in the following folder
strFolder = "C:\GPOXML\"
If Right(strFolder, 1) <> "\" Then strFolder = strFolder & "\"

For Each objFile In objFSO.GetFolder(strFolder).Files
	If Right(LCase(objFile.Name), 4) = ".xml" Then
		'This is the actual name of the XML document minus the path and the ".XML" extension, it becomes the word doc header  
		xmlfile = Left(objFile.Name, Len(objFile.Name) - 4)
		  
		Set objDoc = objWord.Documents.Add()  
		Set objSelection = objWord.Selection  
		objSelection.Font.Name = "Arial"  
		objSelection.Font.Size = "18"  
		objSelection.Font.Bold = True  
		objSelection.TypeText xmlfile & VbCrLf  
		  
		objSelection.Font.Bold = False  
		objSelection.Font.Size = "10"  
		  
		xmlDoc.async="false"  
		xmlDoc.load(strFolder & xmlfile & ".doc")
		'objDoc.SaveAs("C:\GPOXML\" & xmlfile & ".doc") 
		On Error Resume Next
		for each x in xmlDoc.documentElement.childNodes  
		        If Err.Number = 0 Then
			        On Error GoTo 0
			        If x.nodename = "Computer" or x.nodename = "User" Then  
			                For Each y In x.childnodes  
			                        if y.Nodename = "ExtensionData" then  
			                                For Each z In y.childnodes  
			                                        If z.Nodename = "Extension" Then  
			                                                For Each setting In z.childnodes  
			                                                        objSelection.TypeText "______________________________________" & vbCr  
			                                                        DocumentPolicy(Setting)  
			                                                Next  
			                                        End if  
			                                Next  
			                        End if  
			                Next  
			        End If
			    Else
			    	MsgBox "Error reading child nodes in " & objFile.Path & VbCrLf & "Error " & Err.Number & ": " & Err.Description
			    	Err.Clear
			    	On Error GoTo 0
			    End If
		Next
		  
		objDoc.SaveAs(strFolder & xmlfile & ".doc")
		objDoc.Close False
	End If
Next

objWord.Quit
  
'Now, when you run this script against your export there may be some XML tags I   
'didn’t notice because a setting you set is one I didn’t set. Any time you see   
'them in the document you can add a new Case statement in the select case followed   
'by setting the replacestr to the string you want to replace with a null. The   
'lines I’m talking about look similar to this:  
'Case "q2:xxxxxxxx"  
'replacestr = "q2:"  
  
wscript.echo "Done"

Function DocumentPolicy(Setting)
        'this function basically cleans up the headers of the word document, so they are more human readable  
        Select Case setting.nodename  
                Case "q1:Policy"  
                        replacestr = "q1:"  
                Case "q1:DropDownList"  
                        replacestr = "q1:"  
                Case "q1:Name"  
                        replacestr = "q1:"  
                Case "q1:Value"  
                        replacestr = "q1:"  
                Case "q1:State"  
                        replacestr = "q1:"  
                Case "q2:Audit"  
                        replacestr = "q2:"  
                Case "q2:SecurityOptions"  
                        replacestr = "q2:"  
                Case "q2:EventLog"  
                        replacestr = "q2:"  
                Case "q2:RestrictedGroups"  
                        replacestr = "q2:"  
                Case "q2:File"  
                        replacestr = "q2:"  
                Case "q2:Display"  
                        replacestr = "q2:"  
                Case "q3:General"  
                        replacestr = "q3:"  
                Case "q3:HashRule"  
                        replacestr = "q3:"  
                Case "q3:PathRule"  
                        replacestr = "q3:"  
                Case "q3:InternetZoneRule"  
                        replacestr = "q3:"  
                Case "q4:AutoEnrollmentSettings"  
                        replacestr = "q4:"  
                Case "q4:AutoEnrollmentSettings"  
                        replacestr = "q4:"  
                Case "q4:RootCertificateSettings"  
                        replacestr = "q4:"  
                Case "q4:EFSSettings"  
                        replacestr = "q4:"  
                Case "q5:PreferenceMode"  
                        replacestr = "q5:"  
                Case "q2:PreferenceMode"  
                        replacestr = "q2:"  
                Case "q2:ProxySettings"  
                        replacestr = "q2:"  
                Case "q2:UseSameProxy:"  
                        replacestr = "q2:"  
                Case "q2:HTTP:"  
                        replacestr = "q2:"  
                Case "q2:NoProxyIntranet:"  
                        replacestr = "q2:"  
        End Select  
        objSelection.Font.Bold = True  
        objSelection.TypeText VbCrLf & replace(setting.nodename, replacestr,"") & VbCrLf  
        objSelection.Font.Bold = False  
        For Each Value In Setting.Childnodes  
                NodeName = replace(Value.nodename,replacestr,"")  
                If NodeName = "Explain" Then  
                        objSelection.Font.Bold = True  
                        objSelection.TypeText Nodename & ": " & vbcrlf  
                        objSelection.Font.Bold = False  
                        objSelection.TypeText vbTab & replace(value.text,"\n\n", VbCrLf & VbCrLf & vbTab )& vbcrlf  
                Else  
                        objSelection.Font.Bold = True  
                        objSelection.TypeText Nodename & ": "  
                        objSelection.Font.Bold = False  
                        objSelection.TypeText vbtab & value.text & vbcrlf  
                End if  
        Next  
        If isnull(Setting.childnodes) Then  
                For Each node In Setting.childnodes  
                        DocumentPolicy(node)  
                next  
        End if  
        objSelection.TypeText VbCrLf  
End Function

Open in new window

0
 
bsharathAuthor Commented:
I get this

---------------------------

---------------------------
Error reading child nodes in C:\GPOXML\Default Domain Policy.xml

Error 424: Object required
---------------------------
OK  
---------------------------

And then this

---------------------------
Windows Script Host
---------------------------
Script:      C:\GPO Reports in word file Excellent GPOXML.vbs
Line:      50
Char:      3
Error:      Object not a collection
Code:      800A01C3
Source:       Microsoft VBScript runtime error

---------------------------
OK  
---------------------------
0
 
RobSampsonCommented:
Did the original code work with the same XML file?  I haven't changed any of how it processes the XML, so that's odd.

Anyway, try this.

Rob.
Set objFSO = CreateObject("Scripting.FileSystemObject")
Set xmlDoc = CreateObject("Microsoft.XMLDOM")
Set objWord = CreateObject("Word.Application")  

'This will go through each XML file in the following folder
strFolder = "C:\GPOXML\"
If Right(strFolder, 1) <> "\" Then strFolder = strFolder & "\"

For Each objFile In objFSO.GetFolder(strFolder).Files
	If Right(LCase(objFile.Name), 4) = ".xml" Then
		'This is the actual name of the XML document minus the path and the ".XML" extension, it becomes the word doc header  
		xmlfile = Left(objFile.Name, Len(objFile.Name) - 4)
		  
		Set objDoc = objWord.Documents.Add()  
		Set objSelection = objWord.Selection  
		objSelection.Font.Name = "Arial"  
		objSelection.Font.Size = "18"  
		objSelection.Font.Bold = True  
		objSelection.TypeText xmlfile & VbCrLf  
		  
		objSelection.Font.Bold = False  
		objSelection.Font.Size = "10"  
		  
		xmlDoc.async="false"  
		xmlDoc.load(strFolder & xmlfile & ".doc")
		'objDoc.SaveAs("C:\GPOXML\" & xmlfile & ".doc") 
		On Error Resume Next
		for each x in xmlDoc.documentElement.childNodes  
		        If Err.Number = 0 Then
			        'On Error GoTo 0
			        If x.nodename = "Computer" or x.nodename = "User" Then  
			                For Each y In x.childnodes  
			                        if y.Nodename = "ExtensionData" then  
			                                For Each z In y.childnodes  
			                                        If z.Nodename = "Extension" Then  
			                                                For Each setting In z.childnodes  
			                                                        objSelection.TypeText "______________________________________" & vbCr  
			                                                        DocumentPolicy(Setting)  
			                                                Next  
			                                        End if  
			                                Next  
			                        End if  
			                Next  
			        End If
			    Else
			    	MsgBox "Error reading child nodes in " & objFile.Path & VbCrLf & "Error " & Err.Number & ": " & Err.Description
			    	Err.Clear
			    	'On Error GoTo 0
			    End If
		Next
		  
		objDoc.SaveAs(strFolder & xmlfile & ".doc")
		objDoc.Close False
	End If
Next

objWord.Quit
  
'Now, when you run this script against your export there may be some XML tags I   
'didn’t notice because a setting you set is one I didn’t set. Any time you see   
'them in the document you can add a new Case statement in the select case followed   
'by setting the replacestr to the string you want to replace with a null. The   
'lines I’m talking about look similar to this:  
'Case "q2:xxxxxxxx"  
'replacestr = "q2:"  
  
wscript.echo "Done"

Function DocumentPolicy(Setting)
        'this function basically cleans up the headers of the word document, so they are more human readable  
        Select Case setting.nodename  
                Case "q1:Policy"  
                        replacestr = "q1:"  
                Case "q1:DropDownList"  
                        replacestr = "q1:"  
                Case "q1:Name"  
                        replacestr = "q1:"  
                Case "q1:Value"  
                        replacestr = "q1:"  
                Case "q1:State"  
                        replacestr = "q1:"  
                Case "q2:Audit"  
                        replacestr = "q2:"  
                Case "q2:SecurityOptions"  
                        replacestr = "q2:"  
                Case "q2:EventLog"  
                        replacestr = "q2:"  
                Case "q2:RestrictedGroups"  
                        replacestr = "q2:"  
                Case "q2:File"  
                        replacestr = "q2:"  
                Case "q2:Display"  
                        replacestr = "q2:"  
                Case "q3:General"  
                        replacestr = "q3:"  
                Case "q3:HashRule"  
                        replacestr = "q3:"  
                Case "q3:PathRule"  
                        replacestr = "q3:"  
                Case "q3:InternetZoneRule"  
                        replacestr = "q3:"  
                Case "q4:AutoEnrollmentSettings"  
                        replacestr = "q4:"  
                Case "q4:AutoEnrollmentSettings"  
                        replacestr = "q4:"  
                Case "q4:RootCertificateSettings"  
                        replacestr = "q4:"  
                Case "q4:EFSSettings"  
                        replacestr = "q4:"  
                Case "q5:PreferenceMode"  
                        replacestr = "q5:"  
                Case "q2:PreferenceMode"  
                        replacestr = "q2:"  
                Case "q2:ProxySettings"  
                        replacestr = "q2:"  
                Case "q2:UseSameProxy:"  
                        replacestr = "q2:"  
                Case "q2:HTTP:"  
                        replacestr = "q2:"  
                Case "q2:NoProxyIntranet:"  
                        replacestr = "q2:"  
        End Select  
        objSelection.Font.Bold = True  
        objSelection.TypeText VbCrLf & replace(setting.nodename, replacestr,"") & VbCrLf  
        objSelection.Font.Bold = False  
        For Each Value In Setting.Childnodes  
                NodeName = replace(Value.nodename,replacestr,"")  
                If NodeName = "Explain" Then  
                        objSelection.Font.Bold = True  
                        objSelection.TypeText Nodename & ": " & vbcrlf  
                        objSelection.Font.Bold = False  
                        objSelection.TypeText vbTab & replace(value.text,"\n\n", VbCrLf & VbCrLf & vbTab )& vbcrlf  
                Else  
                        objSelection.Font.Bold = True  
                        objSelection.TypeText Nodename & ": "  
                        objSelection.Font.Bold = False  
                        objSelection.TypeText vbtab & value.text & vbcrlf  
                End if  
        Next  
        If isnull(Setting.childnodes) Then  
                For Each node In Setting.childnodes  
                        DocumentPolicy(node)  
                next  
        End if  
        objSelection.TypeText VbCrLf  
End Function

Open in new window

0
 
bsharathAuthor Commented:
yes it did work

I get this
---------------------------

---------------------------
Error reading child nodes in C:\GPOXML\Default Domain Policy.xml

Error 424: Object required
---------------------------
OK  
---------------------------

And the word files are created but unable to open

I get
Word cannot start the converter mswrd632.wpc
0
 
RobSampsonCommented:
Try this.

Regards,

Rob.
Set objFSO = CreateObject("Scripting.FileSystemObject")
Set objWord = CreateObject("Word.Application")  

'This will go through each XML file in the following folder
strFolder = "C:\GPOXML\"
If Right(strFolder, 1) <> "\" Then strFolder = strFolder & "\"

For Each objFile In objFSO.GetFolder(strFolder).Files
	If Right(LCase(objFile.Name), 4) = ".xml" Then
		'This is the actual name of the XML document minus the path and the ".XML" extension, it becomes the word doc header  
		xmlfile = Left(objFile.Name, Len(objFile.Name) - 4)
		  
		Set objDoc = objWord.Documents.Add()  
		Set objSelection = objWord.Selection  
		objSelection.Font.Name = "Arial"  
		objSelection.Font.Size = "18"  
		objSelection.Font.Bold = True  
		objSelection.TypeText xmlfile & VbCrLf  
		  
		objSelection.Font.Bold = False  
		objSelection.Font.Size = "10"  
		  
		Set xmlDoc = CreateObject("Microsoft.XMLDOM")
		xmlDoc.async="false"  
		If xmlDoc.load(strFolder & xmlfile & ".doc") Then
			'objDoc.SaveAs("C:\GPOXML\" & xmlfile & ".doc") 
			On Error Resume Next
			for each x in xmlDoc.documentElement.childNodes  
			        If Err.Number = 0 Then
				        'On Error GoTo 0
				        If x.nodename = "Computer" or x.nodename = "User" Then  
				                For Each y In x.childnodes  
				                        if y.Nodename = "ExtensionData" then  
				                                For Each z In y.childnodes  
				                                        If z.Nodename = "Extension" Then  
				                                                For Each setting In z.childnodes  
				                                                        objSelection.TypeText "______________________________________" & vbCr  
				                                                        DocumentPolicy(Setting)  
				                                                Next  
				                                        End if  
				                                Next  
				                        End if  
				                Next  
				        End If
				    Else
				    	MsgBox "Error reading child nodes in " & objFile.Path & VbCrLf & "Error " & Err.Number & ": " & Err.Description
				    	Err.Clear
				    	'On Error GoTo 0
				    End If
			Next
			  
			objWord.DisplayAlerts = False
			objDoc.SaveAs(strFolder & xmlfile & ".doc")
			objDoc.Close False
			objWord.DisplayAlters = True
		Else
			MsgBox "Failed to load " & objFile.Name
		End If
		Set xmlDoc = Nothing
	End If
Next

objWord.Quit
  
'Now, when you run this script against your export there may be some XML tags I   
'didn’t notice because a setting you set is one I didn’t set. Any time you see   
'them in the document you can add a new Case statement in the select case followed   
'by setting the replacestr to the string you want to replace with a null. The   
'lines I’m talking about look similar to this:  
'Case "q2:xxxxxxxx"  
'replacestr = "q2:"  
  
wscript.echo "Done"

Function DocumentPolicy(Setting)
        'this function basically cleans up the headers of the word document, so they are more human readable  
        Select Case setting.nodename  
                Case "q1:Policy"  
                        replacestr = "q1:"  
                Case "q1:DropDownList"  
                        replacestr = "q1:"  
                Case "q1:Name"  
                        replacestr = "q1:"  
                Case "q1:Value"  
                        replacestr = "q1:"  
                Case "q1:State"  
                        replacestr = "q1:"  
                Case "q2:Audit"  
                        replacestr = "q2:"  
                Case "q2:SecurityOptions"  
                        replacestr = "q2:"  
                Case "q2:EventLog"  
                        replacestr = "q2:"  
                Case "q2:RestrictedGroups"  
                        replacestr = "q2:"  
                Case "q2:File"  
                        replacestr = "q2:"  
                Case "q2:Display"  
                        replacestr = "q2:"  
                Case "q3:General"  
                        replacestr = "q3:"  
                Case "q3:HashRule"  
                        replacestr = "q3:"  
                Case "q3:PathRule"  
                        replacestr = "q3:"  
                Case "q3:InternetZoneRule"  
                        replacestr = "q3:"  
                Case "q4:AutoEnrollmentSettings"  
                        replacestr = "q4:"  
                Case "q4:AutoEnrollmentSettings"  
                        replacestr = "q4:"  
                Case "q4:RootCertificateSettings"  
                        replacestr = "q4:"  
                Case "q4:EFSSettings"  
                        replacestr = "q4:"  
                Case "q5:PreferenceMode"  
                        replacestr = "q5:"  
                Case "q2:PreferenceMode"  
                        replacestr = "q2:"  
                Case "q2:ProxySettings"  
                        replacestr = "q2:"  
                Case "q2:UseSameProxy:"  
                        replacestr = "q2:"  
                Case "q2:HTTP:"  
                        replacestr = "q2:"  
                Case "q2:NoProxyIntranet:"  
                        replacestr = "q2:"  
        End Select  
        objSelection.Font.Bold = True  
        objSelection.TypeText VbCrLf & replace(setting.nodename, replacestr,"") & VbCrLf  
        objSelection.Font.Bold = False  
        For Each Value In Setting.Childnodes  
                NodeName = replace(Value.nodename,replacestr,"")  
                If NodeName = "Explain" Then  
                        objSelection.Font.Bold = True  
                        objSelection.TypeText Nodename & ": " & vbcrlf  
                        objSelection.Font.Bold = False  
                        objSelection.TypeText vbTab & replace(value.text,"\n\n", VbCrLf & VbCrLf & vbTab )& vbcrlf  
                Else  
                        objSelection.Font.Bold = True  
                        objSelection.TypeText Nodename & ": "  
                        objSelection.Font.Bold = False  
                        objSelection.TypeText vbtab & value.text & vbcrlf  
                End if  
        Next  
        If isnull(Setting.childnodes) Then  
                For Each node In Setting.childnodes  
                        DocumentPolicy(node)  
                next  
        End if  
        objSelection.TypeText VbCrLf  
End Function

Open in new window

0
 
bsharathAuthor Commented:
Rob i get this
---------------------------

---------------------------
Failed to load Default Domain Policy.xml
---------------------------
OK  
---------------------------
0
 
bsharathAuthor Commented:
Hi Rob any views on this....
0
 
RobSampsonCommented:
Oh, I just went over the code again, and realised I had
            If xmlDoc.load(strFolder & xmlfile & ".doc") Then

instead of
            If xmlDoc.load(strFolder & xmlfile & ".xml") Then

Sorry about that.  Of course that would fail to load.....

Try this.

Regards,

Rob.
Set objFSO = CreateObject("Scripting.FileSystemObject")
Set objWord = CreateObject("Word.Application")  

'This will go through each XML file in the following folder
strFolder = "C:\GPOXML\"
If Right(strFolder, 1) <> "\" Then strFolder = strFolder & "\"

For Each objFile In objFSO.GetFolder(strFolder).Files
	If Right(LCase(objFile.Name), 4) = ".xml" Then
		'This is the actual name of the XML document minus the path and the ".XML" extension, it becomes the word doc header  
		xmlfile = Left(objFile.Name, Len(objFile.Name) - 4)
		  
		Set objDoc = objWord.Documents.Add()  
		Set objSelection = objWord.Selection  
		objSelection.Font.Name = "Arial"  
		objSelection.Font.Size = "18"  
		objSelection.Font.Bold = True  
		objSelection.TypeText xmlfile & VbCrLf  
		  
		objSelection.Font.Bold = False  
		objSelection.Font.Size = "10"  
		  
		Set xmlDoc = CreateObject("Microsoft.XMLDOM")
		xmlDoc.async="false"  
		If xmlDoc.load(strFolder & xmlfile & ".xml") Then
			'objDoc.SaveAs("C:\GPOXML\" & xmlfile & ".doc") 
			On Error Resume Next
			for each x in xmlDoc.documentElement.childNodes  
			        If Err.Number = 0 Then
				        'On Error GoTo 0
				        If x.nodename = "Computer" or x.nodename = "User" Then  
				                For Each y In x.childnodes  
				                        if y.Nodename = "ExtensionData" then  
				                                For Each z In y.childnodes  
				                                        If z.Nodename = "Extension" Then  
				                                                For Each setting In z.childnodes  
				                                                        objSelection.TypeText "______________________________________" & vbCr  
				                                                        DocumentPolicy(Setting)  
				                                                Next  
				                                        End if  
				                                Next  
				                        End if  
				                Next  
				        End If
				    Else
				    	MsgBox "Error reading child nodes in " & objFile.Path & VbCrLf & "Error " & Err.Number & ": " & Err.Description
				    	Err.Clear
				    	'On Error GoTo 0
				    End If
			Next
			  
			objWord.DisplayAlerts = False
			objDoc.SaveAs(strFolder & xmlfile & ".doc")
			objDoc.Close False
			objWord.DisplayAlters = True
		Else
			MsgBox "Failed to load " & objFile.Name
		End If
		Set xmlDoc = Nothing
	End If
Next

objWord.Quit
  
'Now, when you run this script against your export there may be some XML tags I   
'didn’t notice because a setting you set is one I didn’t set. Any time you see   
'them in the document you can add a new Case statement in the select case followed   
'by setting the replacestr to the string you want to replace with a null. The   
'lines I’m talking about look similar to this:  
'Case "q2:xxxxxxxx"  
'replacestr = "q2:"  
  
wscript.echo "Done"

Function DocumentPolicy(Setting)
        'this function basically cleans up the headers of the word document, so they are more human readable  
        Select Case setting.nodename  
                Case "q1:Policy"  
                        replacestr = "q1:"  
                Case "q1:DropDownList"  
                        replacestr = "q1:"  
                Case "q1:Name"  
                        replacestr = "q1:"  
                Case "q1:Value"  
                        replacestr = "q1:"  
                Case "q1:State"  
                        replacestr = "q1:"  
                Case "q2:Audit"  
                        replacestr = "q2:"  
                Case "q2:SecurityOptions"  
                        replacestr = "q2:"  
                Case "q2:EventLog"  
                        replacestr = "q2:"  
                Case "q2:RestrictedGroups"  
                        replacestr = "q2:"  
                Case "q2:File"  
                        replacestr = "q2:"  
                Case "q2:Display"  
                        replacestr = "q2:"  
                Case "q3:General"  
                        replacestr = "q3:"  
                Case "q3:HashRule"  
                        replacestr = "q3:"  
                Case "q3:PathRule"  
                        replacestr = "q3:"  
                Case "q3:InternetZoneRule"  
                        replacestr = "q3:"  
                Case "q4:AutoEnrollmentSettings"  
                        replacestr = "q4:"  
                Case "q4:AutoEnrollmentSettings"  
                        replacestr = "q4:"  
                Case "q4:RootCertificateSettings"  
                        replacestr = "q4:"  
                Case "q4:EFSSettings"  
                        replacestr = "q4:"  
                Case "q5:PreferenceMode"  
                        replacestr = "q5:"  
                Case "q2:PreferenceMode"  
                        replacestr = "q2:"  
                Case "q2:ProxySettings"  
                        replacestr = "q2:"  
                Case "q2:UseSameProxy:"  
                        replacestr = "q2:"  
                Case "q2:HTTP:"  
                        replacestr = "q2:"  
                Case "q2:NoProxyIntranet:"  
                        replacestr = "q2:"  
        End Select  
        objSelection.Font.Bold = True  
        objSelection.TypeText VbCrLf & replace(setting.nodename, replacestr,"") & VbCrLf  
        objSelection.Font.Bold = False  
        For Each Value In Setting.Childnodes  
                NodeName = replace(Value.nodename,replacestr,"")  
                If NodeName = "Explain" Then  
                        objSelection.Font.Bold = True  
                        objSelection.TypeText Nodename & ": " & vbcrlf  
                        objSelection.Font.Bold = False  
                        objSelection.TypeText vbTab & replace(value.text,"\n\n", VbCrLf & VbCrLf & vbTab )& vbcrlf  
                Else  
                        objSelection.Font.Bold = True  
                        objSelection.TypeText Nodename & ": "  
                        objSelection.Font.Bold = False  
                        objSelection.TypeText vbtab & value.text & vbcrlf  
                End if  
        Next  
        If isnull(Setting.childnodes) Then  
                For Each node In Setting.childnodes  
                        DocumentPolicy(node)  
                next  
        End if  
        objSelection.TypeText VbCrLf  
End Function

Open in new window

0
 
bsharathAuthor Commented:
Thanks Rob it does work but get this error while opening the doc. Other wise all fine
Capture.JPG
0
 
bsharathAuthor Commented:
Rob needed urgent help ..Please let me know if you have time.. I shall post a Q...
I have an excel in Colum H & I i have email addresses like this
Sha@plc.com,Shar@plc.com and many more
Can i get the display names to colum M and I to N Query from AD
Can you help
0
 
bsharathAuthor Commented:
0
 
bsharathAuthor Commented:
Thanks a lot Rob... As Usual life saver.. :-)
0
 
RobSampsonCommented:
That converter error is an error from a recent MS security update.
http://support.microsoft.com/kb/973904

If you back up the following registry key (export it), then delete it:
HKEY_LOCAL_MACHINE\SOFTWARE\Microsoft\Shared Tools\Text Converters\Import\MSWord6.wpc

That error should not occur.

Rob.
0
 
bsharathAuthor Commented:
Thanks Rob.. :-)
0
 
bsharathAuthor Commented:
0

Featured Post

Has Powershell sent you back into the Stone Age?

If managing Active Directory using Windows Powershell® is making you feel like you stepped back in time, you are not alone.  For nearly 20 years, AD admins around the world have used one tool for day-to-day AD management: Hyena. Discover why.

  • 14
  • 8
Tackle projects and never again get stuck behind a technical roadblock.
Join Now