' Изготовление документа Word по шаблону (универсальное) на основе переменных документа (DocVars)
' v3
On Error Resume Next

Set Args = Wscript.Arguments

ProcName  = Args(0) ' имя процедуры для получения данных
pr_key    = Args(1) ' параметр процедуры, идентифицирующий список данных (можно генерировать документы пачками)
NoProtect = Args(2) ' отключение установки защиты на файл "noprotect"
err.Clear
if ProcName = "" or pr_key = "" then 
   Log( "ProcName = '' or pr_key = '': " & CStr(Err.Number) & " " & Err.Description )
   Wscript.Quit -1
end if

'-- пароль защиты документа
wordProtectionPassword = "**********"

'-- сеть
Server  = "\\mtserver\"
Set objNetwork = CreateObject("WScript.Network")
Set colDrives = objNetwork.EnumNetworkDrives
For i = 0 to colDrives.Count - 1 Step 2
    dr = colDrives.Item(i)
    sh = colDrives.Item(i + 1)
    If left(sh, len(Server) ) = Server Then
       if dr = "" then dr = sh
       objNetwork.RemoveNetworkDrive dr, True, False
    End If
Next
ServerShare = Server + "web\Contract"
UserName = "*******l\contract"
Password = "*********"
err.Clear
objNetwork.MapNetworkDrive "", ServerShare, False, UserName, Password
if err.Number <> 0 then
  Log( " objNetwork.MapNetworkDrive: " & CStr(Err.Number) & " " & Err.Description )
  Wscript.Quit -1
end if

'--- соединение с базой ---
Set objAdoConn = CreateObject("ADODB.Connection")
If objAdoConn Is Nothing Then 
  LogFatal( " objAdoConn Is Nothing: " & CStr(Err.Number) & " " & Err.Description )
end if
objAdoConn.ConnectionString = "Provider=SQLOLEDB;Initial Catalog=AVALON2009;Data Source=HPSERVER\#######;integrated security=SSPI;"
objAdoConn.Open 
if objAdoConn.State <> 1 then 
  Log( " objAdoConn.State <> 1: " & CStr(Err.Number) & " " & Err.Description )
  Wscript.Quit -1
end if

'--- открываем рекордсет  ---
Set objAdoRs = objAdoConn.Execute("exec " + ProcName + " " + pr_key, RecordsAffected, 1)
If objAdoRs Is Nothing Then 
  Log( " objAdoConn Is Nothing: " & CStr(Err.Number) & " " & Err.Description )
  Wscript.Quit -1
end if
if objAdoRs.State <> 1 then 
  Log( " objAdoRs.State <> 1: " & CStr(Err.Number) & " " & Err.Description )
  Wscript.Quit -1
end if
if objAdoRs.EOF then
  Log( " objAdoRs.EOF: " & CStr(Err.Number) & " " & Err.Description )
  Wscript.Quit -1
end if

'--- файловая система ---
set objFileSys = CreateObject("Scripting.FileSystemObject")
If objFileSys Is Nothing Then 
  Log( " objFileSys Is Nothing: " & CStr(Err.Number) & " " & Err.Description )
  Wscript.Quit -1
end if

'--- открываем Word ---
Set objWDApp = CreateObject("Word.Application") 
If objWDApp Is Nothing Then 
  Log( " objWDApp Is Nothing: " & CStr(Err.Number) & " " & Err.Description )
  Wscript.Quit -1
end if
objWDApp.Visible = False
objWDApp.DisplayAlerts = 0
objWDApp.Options.CheckSpellingAsYouType = False
objWDApp.Options.CheckGrammarAsYouType = False
objWDApp.Options.SaveInterval = 0

while not objAdoRs.EOF 

  '--- имена файлов ---
  shablon  = ""
  filename = ""
  copyfilename = ""
  shablon  = objAdoRs.Fields("_Shablon").Value
  filename = objAdoRs.Fields("_PathFile").Value 
  copyfilename = objAdoRs.Fields("_CopyPathFile").Value
  copyfilefolder = objAdoRs.Fields("_CopyPathFileFolder").Value
  err.Clear

  If shablon  = "" or filename = "" Then 
    Log( " shablon  = '' or filename = '': " & CStr(Err.Number) & " " & Err.Description )
    objWDApp.Quit(0)
    Wscript.Quit -1
  end if

  '-- копируем шаблон
  if objFileSys.FileExists(shablon) then
     objFileSys.CopyFile shablon, filename, True
     if err.Number <> 0 then
       Log( " objFileSys.CopyFile shablon: [" & shablon & "], filename: [" & filename & "] err: " & CStr(Err.Number) & " " & Err.Description )
       objWDApp.Quit(0)
       Wscript.Quit -1
    end if
  else 
    Log( " objFileSys.FileExists(shablon): [" & shablon & "] err:" & CStr(Err.Number) & " " & Err.Description )
    objWDApp.Quit(0)
    Wscript.Quit -1
  end if

  '-- открываем копию
  Set objWDNewDoc = objWDApp.Documents.Open(filename) 
  If objWDNewDoc Is Nothing or err.Number <> 0 Then 
    Log( " objWDApp.Documents.Open(filename): " & CStr(Err.Number) & " " & Err.Description )
    objWDApp.Quit(0)
    Wscript.Quit -1
  end if

  '-- это позволяет непариться за защищенные шаблоны
  If objWDNewDoc.ProtectionType <> -1 Then 
   objWDNewDoc.Unprotect wordProtectionPassword 
  End If

  ' --- заполняем переменные документа ---
  e = err.Number
  for each r in objAdoRs.Fields

    if left(r.Name, 1) <> "_" then

       v = r.Value
       if v = "" then v = " "

       err.Clear
       objWDNewDoc.Variables(r.Name).Value = v
       if err.Number <> 0 then
         objWDNewDoc.Variables.Add r.Name, v 
       end if

    end if

  next 
  err.Number = e

  ' удаляем ненужные
  e = err.Number
  for each d in objWDNewDoc.Variables

       err.Clear
       v = objAdoRs.Fields(d.Name).Value
       if err.Number <> 0 or left(d.Name, 1) = "_" then
	 objWDNewDoc.Variables(d.Name).Delete 
       end if

  next
  err.Number = e

  ' --- обновляем поля
  for each sr in objWDNewDoc.StoryRanges
     sr.Fields.Update
     While Not (sr.NextStoryRange Is Nothing)
       Set sr = sr.NextStoryRange
       sr.Fields.Update
     Wend
  next
  if err.Number <> 0 then
     Log( " objWDNewDoc.Fields.Update: " & CStr(Err.Number) & " " & Err.Description )
     objWDApp.Quit(0)
     Wscript.Quit -1
  end if
  objWDNewDoc.ActiveWindow.View.ShowFieldCodes = False 

  ' --- блокируем документ 
  if NoProtect <> "noprotect" then 
    'objWDNewDoc.Protect 2, False, "VjhtNh'dtk123"
    objWDNewDoc.Protect 2, False, wordProtectionPassword
    if err.Number <> 0 then
       Log( " objWDNewDoc.Protect: " & CStr(Err.Number) & " " & Err.Description )
    end if
  end if

  objWDNewDoc.Close(-1)
  if err.Number <> 0 then
     Log( " objWDNewDoc.Close(-1): " & CStr(Err.Number) & " " & Err.Description )
     objWDApp.Quit(0)
     Wscript.Quit -1
  end if

  ' --- создаем папку, если запрошено
  if copyfilefolder <> "" and not (objFileSys Is Nothing) then 
     if Not objFileSys.FolderExists(copyfilefolder) Then objFileSys.CreateFolder copyfilefolder
     if err.Number <> 0 then
       Log( " objFileSys.CreateFolder copyfilefolder: [" & copyfilefolder & "] err: " & CStr(Err.Number) & " " & Err.Description )
     end if
  end if

  ' --- копируем документ, если копирование запрошено
  if copyfilename <> "" and not (objFileSys Is Nothing) then 
     if objFileSys.FileExists(filename) Then objFileSys.CopyFile filename, copyfilename, True
     if err.Number <> 0 then
       Log( " objFileSys.CopyFile filename: [" & filename & "], copyfilename: [" & copyfilename & "] err: " & CStr(Err.Number) & " " & Err.Description )
     end if
  end if

  objAdoRs.MoveNext

wend

'--- закрываем Word и коннекты ---
objWDApp.Quit(0)
objAdoRs.Close
objAdoConn.Close

Set objWDNewDoc = Nothing
Set objWDApp = Nothing
set objFileSys = Nothing
Set objAdoRs = Nothing 
Set objAdoConn = Nothing
Set objNetwork = Nothing

'--- записываем ошибку ---
If Err.Number <> 0 Then
  Log( "final Err: " & CStr(Err.Number) & " " & Err.Description )
End If

'===============================================================

Sub Log( str )

  Set objFSO = CreateObject("Scripting.FileSystemObject")
  Set objOutputFile = objFSO.OpenTextFile("MakeDoc_v3." + ProcName + "_" +  pr_key + ".log", 8, True)
  objOutputFile.WriteLine Date & " " & Time & "| " & str 
  objOutputFile.Close
  Set objFSO = Nothing
  Set objOutputFile = Nothing

End Sub