[VB6] Word: stampa unione

[Melly]

il codice seguente mi crea un file di origine contenete una tabella ed effettua la stampa uione con un modello preesistente.

La prima volta procede tutto bene. Il problema nasce se rieseguo la routine mi da il seguente errore nel codice scritto in rosso

errore 462 - Il computer server remoto non esiste o non è disponibile.

ecco il codice

Set WordApp = Nothing
Set WordApp = CreateObject("Word.Application")
Oggi = Date
If CmbSocieta.Text = "" Then
    MsgBox ArrayMsg(3), vbOKOnly + vbExclamation, titolo
Else
    rcs.CursorLocation = adUseClient
    strSql = "select  società,indirizzo,n_civico,cap,città,cod
ice_fiscale,partita_iva from View_Elenco_Società where id_societa=" & CmbSocietàGhost.Text
    Call CheckRcs(strSql, rcs)
    If rcs.EOF = False Then
        WordApp.Documents.Add DocumentType:=wdNewBlankDocument
        WordApp.Visible = True
        Set wSelection = WordApp.Selection 'questo è l'oggetto selezione
         ActiveDocument.Tables.Add wSelection.Range, NumRows:=1, NumColumns:= _
        13, DefaultTableBehavior:=wdWord9TableBehavior, AutoFitBehavior:= _
        wdAutoFitFixed
        wSelection.TypeText Text:="società"
        wSelection.MoveRight Unit:=wdCell
        wSelection.TypeText Text:="indirizzo"
        wSelection.MoveRight Unit:=wdCell
        wSelection.TypeText Text:="n_civico"
        wSelection.MoveRight Unit:=wdCell
        wSelection.TypeText Text:="cap"
        wSelection.MoveRight Unit:=wdCell
        wSelection.TypeText Text:="città"
        wSelection.MoveRight Unit:=wdCell
        wSelection.TypeText Text:="codice_fiscale"
        wSelection.MoveRight Unit:=wdCell
        wSelection.TypeText Text:="partita_iva"
        wSelection.MoveRight Unit:=wdCell
        wSelection.TypeText Text:="Data"
        wSelection.MoveRight Unit:=wdCell
        wSelection.TypeText Text:="DallePrimo"
        wSelection.MoveRight Unit:=wdCell
        wSelection.TypeText Text:="AllePrimo"
        wSelection.MoveRight Unit:=wdCell
        wSelection.TypeText Text:="DalleSecondo"
        wSelection.MoveRight Unit:=wdCell
        wSelection.TypeText Text:="AlleSecondo"
        wSelection.MoveRight Unit:=wdCell
        wSelection.TypeText Text:="GiornoAppuntamento"
        wSelection.MoveRight Unit:=wdCell
        Do Until rcs.EOF = True
            wSelection.TypeText Text:=rcs("società").Value
            wSelection.MoveRight Unit:=wdCell
            wSelection.TypeText Text:=rcs("indirizzo").Value
            wSelection.MoveRight Unit:=wdCell
            wSelection.TypeText Text:=rcs("n_civico").Value
            wSelection.MoveRight Unit:=wdCell
            wSelection.TypeText Text:=rcs("cap").Value
            wSelection.MoveRight Unit:=wdCell
            wSelection.TypeText Text:=rcs("città").Value
            wSelection.MoveRight Unit:=wdCell
            wSelection.TypeText Text:=rcs("codice_Fiscale").Value
            wSelection.MoveRight Unit:=wdCell
            wSelection.TypeText Text:=rcs("partita_iva").Value
            wSelection.MoveRight Unit:=wdCell
            wSelection.TypeText Text:=Oggi
            wSelection.MoveRight Unit:=wdCell
            wSelection.TypeText Text:=TxtDallePrimo.Text
            wSelection.MoveRight Unit:=wdCell
            wSelection.TypeText Text:=TxtAllePrimo.Text
            wSelection.MoveRight Unit:=wdCell
            wSelection.TypeText Text:=TxtDalleSec.Text
            wSelection.MoveRight Unit:=wdCell
            wSelection.TypeText Text:=TxtAlleSec.Text
            wSelection.MoveRight Unit:=wdCell
            wSelection.TypeText Text:=DTPGiornoAppuntamento.Value
            rcs.MoveNext
        Loop
           
        WordApp.ActiveDocument.SaveAs FileName:=App.Path & "\Modelli\Comunicazione.doc"
        WordApp.ActiveDocument.Close
        Call StartaWord("ModelloComunicazione.doc")         
        
        With WordApp.Documents(1).MailMerge
            .MainDocumentType = wdFormLetters
            
            .OpenDataSource Name:=App.Path & "\Modelli\Comunicazione.doc"  '-> edz.doc
            
            .SuppressBlankLines = True 'bypassa i record vuoti
             
            '.Destination = wdSendToPrinter 'così manda tutto alla stampante
            .Destination = wdSendToNewDocument
            .Execute
            
        End With
        WordApp.WindowState = wdWindowStateMaximize
        WordApp.Windows.Item(2).Close 
        WordApp.Documents(1).PrintPreview
        WordApp.ActiveWindow.Caption = "Comunicazione"
        WordApp.ActiveWindow.Visible = True
        Set wSelection = Nothing
    End If
    rcs.Close
End If