'
' Процедура главная :: начало
'
Sub SetMyVars()
'
' SetMyVars Макрос
'
' Установка значений переменных
' Автор: wpvi.ru
' Находится здесь: https://wpvi.ru/fs/soft/word/setmyvars_ver103.txt
' Используется здесь: https://wpvi.ru/pages/soft/word/
' Версия 1.03 от 20230618
'
  Quest1 = "Добрый день, " & Application.UserName & " !" & Chr(13) & "Вы действительно хотите запустить процесс установки значений переменных?"
  Ans1 = MsgBox(Quest1, vbYesNo)
  If Ans1 = vbYes Then
    ' Запуск расчета
    rez1 = make_SetMyVars()
  Else
    ' Отказ от запуска расчета
    rez1 = decline_SetMyVars()
  End If
  Exit Sub
End Sub
'
' Процедура главная :: завершение
'
Public Function decline_SetMyVars() As Boolean
  MsgBox "Вы отказались от установки значений переменных!"
  task_done = False
  Exit Function
End Function

Public Function make_SetMyVars() As Boolean
' начало основной функции
  Dim varValue As String
  Dim xDoc As New MSXML2.DOMDocument60
  Dim node As IXMLDOMElement
  fmt2 = "00000"
  dir2 = "d:\mso\word\"
' Дата и Время текущие, локальные...
  varDT = Now()
' Дефолтные заглушки на всякий случай...
  varTO_WHOM2 = "Лучший начальник в мире"
  varWHERE2 = "Лучшая компания в мире"
  varFIELD2 = "Производство лучших в мире колбас, огурцов, а также всего, что понадобиться впредь"
  varEMAIL2 = "sobak@tut.net"
  MsgBox "Вы согласились установить значения переменных!"
' Информацию берем из файла XML
  Set xDoc = New MSXML2.DOMDocument60
  With xDoc
    .async = False
    .validateOnParse = True
  If xDoc.Load(dir2 + "hh_list.xml") = False Then
'  Что-то пошло не так, скорее всего нет файла или не получается его открыть...
    Debug.Print .parseError.reason, .parseError.ErrorCode
'    MsgBox .parseError.reason, .parseError.ErrorCode
    MsgBox .parseError.reason
    MsgBox .parseError.ErrorCode
    Exit Function
  End If
  End With
  x = 0
  Do While x < 3
    varDT = Now() ' Обновляем время, это может быть полезны, если мы содаем большое кол-во файлов...
    x = x + 1
    xStr = Format(x, fmt2)
    nodeStr = "//company" + xStr
'   MsgBox "xStr = " + xStr
    Set node = xDoc.SelectSingleNode(nodeStr)
'   Перебиваем дефолты
    varTO_WHOM2 = node.SelectSingleNode("to_whom2").Text
    varWHERE2 = node.SelectSingleNode("where2").Text
    varFIELD2 = node.SelectSingleNode("field2").Text
    varEMAIL2 = node.SelectSingleNode("email2").Text
'   Подставляем имеющие значения в переменные
    ActiveDocument.Variables.Item("TO_WHOM2").Value = varTO_WHOM2
    ActiveDocument.Variables.Item("WHERE2").Value = varWHERE2
    ActiveDocument.Variables.Item("FIELD2").Value = varFIELD2
    ActiveDocument.Variables.Item("EMAIL2").Value = varEMAIL2
    ActiveDocument.Variables.Item("TIME2").Value = varDT
'   Обновляем, т.е. просто пытаемся автоматизировать ручную работу: CTRL-A, F9
    ActiveDocument.Fields.Update
    FileStr = dir2 + "file" + xStr + ".docx"
'   MsgBox "FileStr = " + FileStr
'   Записываем файл с новыми данными:
    ActiveDocument.SaveAs FileName:=FileStr, FileFormat:=wdFormatDocumentDefault
  
    task_done = True
  Loop
' конец цикла
'
' Закрываем активный документ Ворда
  ActiveDocument.Close

  Exit Function
' окончание основной функции
End Function