Sub TeeDocTiedostot()
Dim appWD As Word.Application
Dim DocWD As Word.Document
Dim wdRngTable As Word.Range   'create a range variable
Dim i As Integer, j As Integer
Dim strDocTiedosto As String, strKansionNimi As String
Dim strSep As String
strSep = Application.PathSeparator
 
'Käytetään kansion nimenä tätä hetkeä
strKansionNimi = Format(Now, "dd-mm-yy-hh-mm-ss")
 
'Tehdään uusi kansio, jonne Word-tiedostot tulostetaan
MkDir ThisWorkbook.Path & Application.PathSeparator & strKansionNimi
 
'Avataan ja näytetään Word
Set appWD = CreateObject("Word.Application")
appWD.Visible = False
 
'Käydään palautteen saajat läpi
For j = LBound(vPalautteet, 1) To UBound(vPalautteet, 1) - 1
 
  'Rakennetaan tiedostonimi
  strDocTiedosto = ThisWorkbook.Path & strSep & strKansionNimi & strSep & j & ".doc"
 
  'Käske Wordia tekemään uusi dokumentti
  Set DocWD = appWD.Documents.Add
 
  With DocWD
    'Haetaan Wordista oikea kohta
    Set wdRngTable = .Range(0, 0)
 
    'Ja luodaan uusi taulu
    .Tables.Add wdRngTable, 1, 2
 
    With .Tables(1)
      .PreferredWidth = InchesToPoints(10#)
      .Range.Font.Size = 10
      .Range.Font.Name = "Arial"
      .Style = "Table Grid"
    End With
 
    'Tallennetaan tiedosto
    .SaveAs (strDocTiedosto)
 
    'Suljetaan tämä dokumentti
    .Close
 
  End With
Next j
 
'Suljetaan word
appWD.Quit
Set wdRngTable = Nothing: Set DocWD = Nothing: Set appWD = Nothing
End Sub