Fehler: Der Remote Server Computer exist
11.04.2022 09:34:50
Julian
nun habe ich ein neues Problem beim Speichern meiner Serienbriefe.
Mit folgendem Code funktioniert alles einwandfrei. Auch das Speichern und anschließende Schließen von Word.
Das Ganze funktioniert allerdings nur ein mal, dann scheint im Speicher noch irgendetwas rumzuschwirren, dass folgende Fehlermeldung beim zweiten Versuch auftaucht:
Der Remote Server Computer existiert nicht oder ist nicht verfügbar
Set docneu = Word.ActiveDocument
Option Explicit
Sub serie_modul_zwei()
'-------------------------------------------
Dim ws As Worksheet
Set ws = ActiveSheet
Dim varRange As Excel.Range
Dim filter As Variant
Dim name As String
name = (Environ("USERNAME"))
If name = "Julian" Then
name = "C:\Users\Julian"
ElseIf name = "alexa" Then
name = "C:\Users\alexa"
End If
filter = 1
'
'*pruefe, ob in der Spalte FP ein Eintrag vorhanden ist
Dim intSendezeile As Integer
intSendezeile = 0
Dim intZeile As Integer
For intZeile = 1 To 1000
If ws.Range("FP" & intZeile).Value = 1 Then
intSendezeile = intZeile
Exit For
End If
Next
' check sende1 >
'
If intSendezeile = 0 Then
MsgBox "Es gibt keine Zeile die gesendet werden kann. Alle Zellen in Spalte FP sind leer", vbCritical, "fp_Excel_Word_Serienbrief_erstellen()"
Exit Sub
End If
' Kontrolle >
'*diese Funktion oeffnet den Serienbrief BR-Mittelung
Dim sFilename As String
sFilename = name & "\OneDrive\XXXX\100 - Intern\100 - Bestellungen\100 - Orderbuch\Serienbrief\Kontrollboegen Hausarbeiten" & "\" & "Auswertung XXXX.docx"
'
'Dim fs As New FileSystemObject
'If fs.FileExists(sFilename) = False Then
' MsgBox "Die Datei existiert nicht" & vbCrLf & "Dateiname:" & sFilename, vbCritical, "fp_Excel_Word_Serienbrief_erstellen()"
' Exit Sub
'End If
' check Document >
'
Dim wordApp As Object 'As New Word.Application 'Word-dll
Set wordApp = CreateObject("Word.Application")
wordApp.Visible = True
' Word starten >
'
'Dim doc As Object
Dim doc As Word.Document 'word-dll
Dim docneu As Word.Document
Set doc = CreateObject("Word.Document")
Set doc = wordApp.Documents.Open(sFilename, ConfirmConversions:=False, ReadOnly:=False, AddToRecentFiles:=False)
' Word Document oeffnen >
Dim wb As Workbook
Set wb = ThisWorkbook
Dim sExcel_Filename As String
sExcel_Filename = name & "\OneDrive\XXXX\100 - Intern\100 - Bestellungen\100 - Orderbuch\XXXX.xlsm"
'1
'*Datenquelle für den Seriendruck
If wordApp.Build Like "12*" Then
'--
'doc.MailMerge.OpenDataSource name:=sExcel_Filename _
, Connection:="Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & sExcel_Filename & ";Mode=Read;Extended Properties=""HDR=YES;IMEX=1;Jet OLEDB:Eng;TypeGuessRows=0;" _
, SQLStatement:="SELECT * FROM `Adressen`", SQLStatement1:=" WHERE Anschreiben='1'", SubType:=1
'*subtype:=1=wdMergeSubTypeAccess
'- Ist_Office2007 >-
Else
'--
doc.MailMerge.OpenDataSource name:=sExcel_Filename, Connection:="Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & sExcel_Filename & ";Mode=Read;Extended Properties=""HDR=YES;IMEX=1;Jet OLEDB:Eng;TypeGuessRows=0;" _
, SQLStatement:="SELECT * FROM `Bestellungen$`", SQLStatement1:=" WHERE Serienbrief='1'", SubType:=1
'*subtype:=1=wdMergeSubTypeAccess
'- Ist_Office2010 >-
End If
' Datenquelle einstellen >
'
If Err.Number = 9 Then
'Fehler Maric... Update()
Err.Clear
doc.MailMerge.Execute
ElseIf Err.Number 0 Then
MsgBox "Fehler beim Daten holen Word von Excel." & vbCrLf & Err.Description, vbCritical, "fp_Excel_Word_Serienbrief_erstellen()"
Else
doc.MailMerge.Execute
End If
' Serienbrief erzeugen >
doc.Close False
Set docneu = Word.ActiveDocument
'
' Hauptdocument schliessen >
ActiveDocument.SaveAs Sheets("SVERWEISE").Range("BB1").Value & "\" & Sheets("SVERWEISE").Range("BB2").Value & ".docx"
docneu.Close False
wordApp.Quit
Set docneu = Nothing
Set doc = Nothing
Set wordApp = Nothing
'-------------------------------------------
End Sub