Hi,
Code:
Option Compare Database
Option Explicit
Public Function percorsodatabase() As String
percorsodatabase = "\\192.158.1.38\Master Documenti\"
End Function
Public Function percorsoimmagini() As String
percorsoimmagini = "\\192.158.1.38\Immagini\"
End Function
Private Sub CmdCreaDocTecnica_Click()
Dim Wrd As Word.Application, Doc As Word.Document
Dim rst As DAO.Recordset
Dim Modello As String, NomeFile As String, i As Integer
Dim Record As String, SQL As String
Dim Tbl As String * 1
Dim ReplSel As Boolean
Dim stDocName As String
Dim FirmaRL As String
Dim idfirmaRL As String
Modello = percorsodatabase & "DOCUMENTAZIONE.docx"
On Error Resume Next
Set Wrd = GetObject(, "Word.Application")
If Err.Number = 429 Then
Set Wrd = CreateObject("Word.Application")
End If
On Error GoTo 0
Wrd.Visible = True
Wrd.Activate
ReplSel = Wrd.Options.ReplaceSelection
Wrd.Options.ReplaceSelection = True
Set Doc = Wrd.Documents.Add(Modello)
Doc.Activate
idfirmaRL = Txt_RL_ID
FirmaRL = percorsoimmagini & idfirmaRL & ".png"
Wrd.ActiveDocument.Bookmarks("FirmaRL1").Select
Selection.Find.ClearFormatting
With Selection.Find
.Text = ""
.Replacement.Text = ""
.Forward = True
.Wrap = wdFindContinue
.Format = False
.MatchCase = False
.MatchWholeWord = False
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
End With
Selection.InlineShapes.AddPicture FileName:=FirmaRL, LinkToFile:=False, SaveWithDocument:=True
DoCmd.RunCommand acCmdSaveRecord 'salva
Wrd.Selection.HomeKey Unit:=wdStory 'torna con il cursore ad inizio documento
'aggiorna sommario word
If ActiveDocument.Fields.Update = 0 Then
Else
MsgBox "Field " & ActiveDocument.Fields.Update & "Esportazione bloccata, controlla i campi inseriti"
End If
Wrd.Application.WordBasic.MsgBox "Ottimo... Esportazione terminata!", "Esportazione dati da Access"
Set Doc = Nothing
Set Wrd = Nothing
End Sub