NO EXPERIENCE ON MERGE recordset in a Word document

User avatar
HansV
Administrator
Posts: 78237
Joined: 16 Jan 2010, 00:14
Status: Microsoft MVP
Location: Wageningen, The Netherlands

Re: NO EXPERIENCE ON MERGE recordset in a Word document

Post by HansV »

Code: Select all

        objDoc.SaveAs Filename:=strPath & "Test" & i & ".docx"
becomes

Code: Select all

        objWrd.DisplayAlerts = False
        objDoc.SaveAs Filename:=strPath & "Test" & i & ".docx"
        objWrd.DisplayAlerts = True
Best wishes,
Hans

User avatar
sal21
PlatinumLounger
Posts: 4334
Joined: 26 Apr 2010, 17:36

Re: NO EXPERIENCE ON MERGE recordset in a Word document

Post by sal21 »

HansV wrote:
10 Nov 2020, 19:26

Code: Select all

        objDoc.SaveAs Filename:=strPath & "Test" & i & ".docx"
becomes

Code: Select all

        objWrd.DisplayAlerts = False
        objDoc.SaveAs Filename:=strPath & "Test" & i & ".docx"
        objWrd.DisplayAlerts = True
TKS.
But curiosity...
possible to show Word with the saved file , in front, and cover the form?

for example:
"can you show the .doc in Word? yes/no?

User avatar
HansV
Administrator
Posts: 78237
Joined: 16 Jan 2010, 00:14
Status: Microsoft MVP
Location: Wageningen, The Netherlands

Re: NO EXPERIENCE ON MERGE recordset in a Word document

Post by HansV »

Does this do what you want?

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.PageSetup.PaperSize = 7
        objDoc.PrintOut
        objWrd.DisplayAlerts = False
        objDoc.SaveAs Filename:=strPath & "Test" & i & ".docx"
        objWrd.DisplayAlerts = True
        If MsgBox("Do you want to display the document?", vbQuestion + vbYesNo) = vbYes Then
            objWrd.Visible = True
            objWrd.Activate
        Else
            objDoc.Close SaveChanges:=False
            Set objDoc = Nothing
        End If
        rs.MoveNext
    Loop
ExitHandler:
    rs.Close
    cn.Close
    On Error Resume Next
    If f And Not objWrd Is Nothing And Not objDoc Is Nothing Then
        objWrd.Quit SaveChanges:=False
    End If
    Exit Sub
ErrHandler:
    MsgBox Err.Description, vbExclamation
    Resume ExitHandler
End Sub
Best wishes,
Hans

User avatar
sal21
PlatinumLounger
Posts: 4334
Joined: 26 Apr 2010, 17:36

Re: NO EXPERIENCE ON MERGE recordset in a Word document

Post by sal21 »

:clapping:
HansV wrote:
11 Nov 2020, 09:59
Does this do what you want?

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.PageSetup.PaperSize = 7
        objDoc.PrintOut
        objWrd.DisplayAlerts = False
        objDoc.SaveAs Filename:=strPath & "Test" & i & ".docx"
        objWrd.DisplayAlerts = True
        If MsgBox("Do you want to display the document?", vbQuestion + vbYesNo) = vbYes Then
            objWrd.Visible = True
            objWrd.Activate
        Else
            objDoc.Close SaveChanges:=False
            Set objDoc = Nothing
        End If
        rs.MoveNext
    Loop
ExitHandler:
    rs.Close
    cn.Close
    On Error Resume Next
    If f And Not objWrd Is Nothing And Not objDoc Is Nothing Then
        objWrd.Quit SaveChanges:=False
    End If
    Exit Sub
ErrHandler:
    MsgBox Err.Description, vbExclamation
    Resume ExitHandler
End Sub
:clapping: :clapping: :clapping: :clapping: :clapping: :cheers: