Sending from excel to word template
 

PLEASE HELP ME
i have macro like this below which includes records from excel to word
template, but I'd like to convert it in such way, that it includes
records from excel to one word document (It is preparing one word
document now for every record from excel). It should works like that:
excel opens word template and inludes every record from excel to
bookmarks in word template and then it saves document. Are You able to
convert this macro below?

Best regards
Thomas

Sub Auto_open()
Range("Bad name of file") = ThisWorkbook.path & "\" & "szablon.doc"
End Sub
Private Sub ExtractFilePathNameExt(Plik, path, name, ext)
For i = Len(Plik) To 1 Step -1
Select Case Mid(Plik, i, 1)
Case "."
ext = Mid(Plik, i + 1)
extPos = i
Case "\"
If path = "" Then path = Mid(Plik, 1, i - 1)
name = Mid(Plik, i + 1, extPos - i - 1)
Exit For
End Select
Next i
End Sub
Private Sub MS_Word(Plik, r As Range, Optional path)
Dim wd As Object

If IsMissing(path) Then path = ""

'Utworzenie sesji Microsoft Word
On Error Resume Next
Set wd = GetObject(, "word.application")
If Err.Number < 0 Then
Err.Clear
Set wd = CreateObject("word.application")
End If
On Error GoTo 0

ExtractFilePathNameExt Plik, path, name, ext
nr = 0
wd.Documents.Open Plik
Set rw = r.Range("a2", Cells(r.Rows.Count, r.Columns.Count))
k = 0
For Each i In rw.Rows
For j = 0 To rw.Columns.Count - 1
TypeToWord wd, r.Offset(0, j).Cells(1), rw.Offset(k,
j).Cells(1)
Next j
wd.activedocument.SaveAs path & "\karty\" & name & " " & nr & "."
& ext
k = k + 1
nr = nr + 1



Next i

wd.Quit
Set wd = Nothing
End Sub


Private Sub TypeToWord(wd, name, text)
On Error Resume Next
wd.activedocument.GoTo(name:=name).Select
If Err.Number = 0 Then
wd.Selection.text = text
On Error GoTo 0
With wd.activedocument.Bookmarks

.Add Range:=wd.Selection.Range, name:=name

.DefaultSorting = wdSortByName
.ShowHidden = False
End With
Else
Err.Clear
End If
End Sub
Sub Makro1()
If Dir(Range("Nazwa_Pliku_tekstowego").text) = "" Then
MsgBox "Wrong name of text file"
Range("Nazwa_Pliku_tekstowego").Select
Exit Sub
End If
MS_Word Range("Nazwa_Pliku_tekstowego").text, Range("TabelaDanych")
End Sub


--
pizdus
------------------------------------------------------------------------
pizdus's Profile: http://www.excelforum.com/member.php...o&userid=30565
View this thread: http://www.excelforum.com/showthread...hreadid=502142