vbs修改word内容

BuildVersion = "WScript.BuildVersion:"+CStr(WScript.BuildVersion)+chr(10)
FullName = "WScript.FullName:"+WScript.FullName+chr(10) 
Interactive = "WScript.Interactive:"+CStr(WScript.Interactive)+chr(10)
Name = "WScript.Name:"+CStr(WScript.Name)+chr(10)   
Path = "WScript.Path:"+WScript.Path+chr(10)  
ScriptFullName = "WScript.ScriptFullName:"+WScript.ScriptFullName+chr(10)
ScriptName = "WScript.ScriptName:"+WScript.ScriptName+chr(10)
Version = "WScript.Version:"+WScript.Version+chr(10)
Timeout = "WScript.Timeout:"+CStr(WScript.Timeout)+chr(10)
Arguments=""


For I = 0 to WScript.Arguments.Count - 1
Arguments = Arguments + "Arguments"+CStr(I)+":"+WScript.Arguments(I)+chr(10)
Next
'MsgBox BuildVersion+FullName+Interactive+Name+ScriptFullName+ScriptName+Version+Timeout+Arguments



For I = 0 to WScript.Arguments.Count - 1
DocPathName = WScript.Arguments(I)
Call ProcessWord(DocPathName)
Next

Private  Function GetHeader(str,line)
	GetHeader = ""
	l = len(str)
	if l > 0 then
	   for k=1 to len(str) 
			ch = mid(str,k,1)
			if line= 84 then
				MsgBox(str &"" &ch)
			end if
			if IsNumeric(ch) or ch = "."  then	
				GetHeader = Mid(str,1,k)
			else 
				Exit For
			end if
		next

	end if
					
End Function

Private Function GetHeaderLever(str)
	level=1
	for h=1 to len(str)
		if mid(str,h,1) = "." then
			level = level +1
		end if
	next	
	GetHeaderLever = level
end Function

Private Function SetStyle(p,level,file)

	if level = 1 then
		p.Range.Font.Size = 30
		'p.Range.Font.Name = "??"	
		p.Range.Font.Bold  = FALSE
		p.Range.Font.Italic   = TRUE	
		p.SpaceAfter  =0
		p.SpaceBefore =0
	elseif  level = 2 then
		p.Range.Font.Size = 20
		'P.Range.Font.ColorIndex   = 1
		P.Space2
		p.LineUnitBefore  =0
		p.LineUnitAfter =0
		'P.IndentCharWidth(4)
		'P.IndentFirstLineCharWidth(2)
	elseif level = 3 then
		p.Range.Font.Size = 10
		P.Space15 
	end if
	file.WriteLine(level)
end Function


Private Function ProcessWord(DocPathName)
	if Right(DocPathName,4) <> ".doc" and Right(DocPathName,5) <>".docx" then
		MsgBox "NO word"
	end if
	
	 Set fso = CreateObject("Scripting.FileSystemObject")
	 set file = fso.CreateTextFile ("C:\test.txt",true)
	 file.WriteLine("abdfdfc")
	
	Set objWord = CreateObject("Word.Application")
	objWord.Visible = true 
	
	Set Document = objWord.Documents.Open(DocPathName)
	for i=1 to Document.Paragraphs.Count
		t1 = Document.Paragraphs(i).Range.Text
		t=  Document.Paragraphs(i).Range.ListFormat.ListString 
		tt = GetHeader(t,i)

		if len(tt) >0 then
			call SetStyle(Document.Paragraphs(i),GetHeaderLever(tt),file)
		end if		
			file.WriteLine(i &" " & tt & "==(" & GetHeaderLever(tt)&")"& t)
	
	next
	
	file.Close()
	'Document.Close
	

End Function