NO EXPERIENCE ON MERGE recordset in a Word document

[sal21]

I just have a filled recorset, with:

indirizzo
nome
città

i need to fill a template word, with a fixed filed with:

indirizzo: rs.indirizzo
nome: rs.nome
citta: rs.citta

liitle project?
tks.

note:
the word file is stored in c:\servizo\miodoc.doc.

[HansV]

You can use a SQL string for mail merge, but not a recordset.
If you want to use a recordset, you'd have to do all the work in your code instead of letting Word do it. See for example Merging data from Queries and Recordsets to Word, Part 1

[sal21]

Ok
But can you upload an example of Word doc with a girls, for a filling data?
In other case the link for download the example you have post, dont work.

[HansV]

Does your recordset return more than one record?
If so, do you want to fill one document with all records, or do you want a separate document for each record?

[sal21]

Separate....

[HansV]

What should those documents be named?

[sal21]

With a count....
I=i+1

[HansV]

Here is an example:

Code: Select all

Sub Test()
    Dim cn As ADODB.Connection
    Dim rs As ADODB.Recordset
    Dim objWrd As Object
    Dim objDoc As Object
    Dim f As Boolean
    Dim i As Long
    On Error Resume Next
    Set objWrd = GetObject(Class:="Excel.Application")
    If objWrd Is Nothing Then
        Set objWrd = CreateObject(Class:="Excel.Application")
        f = True
    End If
    On Error GoTo ErrHandler
    ' Code to open cn and rs goes here
    '...
    '...
    Do While Not rs.EOF
        i = i + 1
        Set objDoc = objWrd.Documents.Add
        objDoc.Content.InsertAfter Text:="Indirizzo " & rs!Indirizzo
        objDoc.Content.InsertAfter Text:="Nome " & rs!Nome
        objDoc.Content.InsertAfter Text:="Città " & rs!Città
        objDoc.SaveAs Filename:="Test" & i & ".docx"
        objDoc.Close SaveChanges:=False
        rs.MoveNext
    Loop
ExitHandler:
    rs.Close
    cn.Close
    On Error Resume Next
    If f And Not objWrd Is Nothing Then
        objWrd.Quit SaveChanges:=False
    End If
    Exit Sub
ErrHandler:
    MsgBox Err.Description, vbExclamation
    Resume ExitHandler
End Sub

[sal21]

Here is an example:

Code: Select all

Sub Test()
    Dim cn As ADODB.Connection
    Dim rs As ADODB.Recordset
    Dim objWrd As Object
    Dim objDoc As Object
    Dim f As Boolean
    Dim i As Long
    On Error Resume Next
    Set objWrd = GetObject(Class:="Excel.Application")
    If objWrd Is Nothing Then
        Set objWrd = CreateObject(Class:="Excel.Application")
        f = True
    End If
    On Error GoTo ErrHandler
    ' Code to open cn and rs goes here
    '...
    '...
    Do While Not rs.EOF
        i = i + 1
        Set objDoc = objWrd.Documents.Add
        objDoc.Content.InsertAfter Text:="Indirizzo " & rs!Indirizzo
        objDoc.Content.InsertAfter Text:="Nome " & rs!Nome
        objDoc.Content.InsertAfter Text:="Città " & rs!Città
        objDoc.SaveAs Filename:="Test" & i & ".docx"
        objDoc.Close SaveChanges:=False
        rs.MoveNext
    Loop
ExitHandler:
    rs.Close
    cn.Close
    On Error Resume Next
    If f And Not objWrd Is Nothing Then
        objWrd.Quit SaveChanges:=False
    End If
    Exit Sub
ErrHandler:
    MsgBox Err.Description, vbExclamation
    Resume ExitHandler
End Sub

TKS bro.

but:

- why Excel object?
- and i just have a template in c:\servizio\TEST.DOC (see attached file)
- I'm on vb6

[HansV]

Sorry, my mistake. It should be Class:="Word.Application" both times.

Where is Test.doc?

[sal21]

Sorry, my mistake. It should be Class:="Word.Application" both times.

Where is Test.doc?

c:\servizio\TEST.DOC

[HansV]

Is Indirizzo rs.doc (attached to the first post in this thread) the document that you mean?

[sal21]

ops....
the real documento contain a different name.

I can send in private?

i need to fill after Sig. the rs.sig
i need to fill after di the rs.nome
i need to fill after Via the rs.indirizzo

the part are red in the doc.

[HansV]

You know my email address...

[sal21]

You know my email address...

sent

[HansV]

Try this:

Code: Select all

Sub Test()
    Const strPath = "C:\Servizio\"
    Dim cn As ADODB.Connection
    Dim rs As ADODB.Recordset
    Dim objWrd As Object
    Dim objDoc As Object
    Dim f As Boolean
    Dim i As Long
    On Error Resume Next
    Set objWrd = GetObject(Class:="Word.Application")
    If objWrd Is Nothing Then
        Set objWrd = CreateObject(Class:="Word.Application")
        f = True
    End If
    On Error GoTo ErrHandler
    ' Code to open cn and rs goes here
    '...
    '...
    Do While Not rs.EOF
        i = i + 1
        Set objDoc = objWrd.Documents.Open(strPath & "Test.doc")
        With objWrd.Selection.Find
            .ClearFormatting
            .Replacement.ClearFormatting
            .MatchWildcards = True
            .Execute FindText:="-{1,}", ReplaceWith:=rs!Sig, Replace:=1
            objWrd.Selection.Collapse Direction:=0
            .Execute FindText:="-{1,}", ReplaceWith:=rs!Nome, Replace:=1
            objWrd.Selection.Collapse Direction:=0
            .Execute FindText:="-{1,}", ReplaceWith:=rs!Indirizzo, Replace:=1
            objWrd.Selection.Collapse Direction:=0
        End With
        objDoc.SaveAs Filename:=strPath & "Test" & i & ".docx"
        objDoc.Close SaveChanges:=False
        rs.MoveNext
    Loop
ExitHandler:
    rs.Close
    cn.Close
    On Error Resume Next
    If f And Not objWrd Is Nothing Then
        objWrd.Quit SaveChanges:=False
    End If
    Exit Sub
ErrHandler:
    MsgBox Err.Description, vbExclamation
    Resume ExitHandler
End Sub

[sal21]

Try this:

Code: Select all

Sub Test()
    Const strPath = "C:\Servizio\"
    Dim cn As ADODB.Connection
    Dim rs As ADODB.Recordset
    Dim objWrd As Object
    Dim objDoc As Object
    Dim f As Boolean
    Dim i As Long
    On Error Resume Next
    Set objWrd = GetObject(Class:="Word.Application")
    If objWrd Is Nothing Then
        Set objWrd = CreateObject(Class:="Word.Application")
        f = True
    End If
    On Error GoTo ErrHandler
    ' Code to open cn and rs goes here
    '...
    '...
    Do While Not rs.EOF
        i = i + 1
        Set objDoc = objWrd.Documents.Open(strPath & "Test.doc")
        With objWrd.Selection.Find
            .ClearFormatting
            .Replacement.ClearFormatting
            .MatchWildcards = True
            .Execute FindText:="-{1,}", ReplaceWith:=rs!Sig, Replace:=1
            objWrd.Selection.Collapse Direction:=0
            .Execute FindText:="-{1,}", ReplaceWith:=rs!Nome, Replace:=1
            objWrd.Selection.Collapse Direction:=0
            .Execute FindText:="-{1,}", ReplaceWith:=rs!Indirizzo, Replace:=1
            objWrd.Selection.Collapse Direction:=0
        End With
        objDoc.SaveAs Filename:=strPath & "Test" & i & ".docx"
        objDoc.Close SaveChanges:=False
        rs.MoveNext
    Loop
ExitHandler:
    rs.Close
    cn.Close
    On Error Resume Next
    If f And Not objWrd Is Nothing Then
        objWrd.Quit SaveChanges:=False
    End If
    Exit Sub
ErrHandler:
    MsgBox Err.Description, vbExclamation
    Resume ExitHandler
End Sub

I HAVE NO WORDS!
tKS.

[sal21]

Mummmm.
Before to save, Is possibile to set A4 Page and print the doc to the default printer?

[HansV]

Insert the following lines below the line End With:

Code: Select all

        objDoc.PageSetup.PaperSize = 7
        objDoc.PrintOut

[sal21]

Insert the following lines below the line End With:

Code: Select all

        objDoc.PageSetup.PaperSize = 7
        objDoc.PrintOut

tKS!

But possible to everwrite the .doc with the same name, without windows allert?