Code: Select all
objDoc.SaveAs Filename:=strPath & "Test" & i & ".docx"
Code: Select all
objWrd.DisplayAlerts = False
objDoc.SaveAs Filename:=strPath & "Test" & i & ".docx"
objWrd.DisplayAlerts = True
Code: Select all
objDoc.SaveAs Filename:=strPath & "Test" & i & ".docx"
Code: Select all
objWrd.DisplayAlerts = False
objDoc.SaveAs Filename:=strPath & "Test" & i & ".docx"
objWrd.DisplayAlerts = True
TKS.HansV wrote: ↑10 Nov 2020, 19:26becomesCode: Select all
objDoc.SaveAs Filename:=strPath & "Test" & i & ".docx"
Code: Select all
objWrd.DisplayAlerts = False objDoc.SaveAs Filename:=strPath & "Test" & i & ".docx" objWrd.DisplayAlerts = True
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
HansV wrote: ↑11 Nov 2020, 09:59Does 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