Word wird nicht befüllt?
19.08.2021 08:27:11
Martina
Ich würde gerne aus einer Excel heraus per Serienbrief (nach vorhergehender festgelegter Bedingung) einen Brief erzeugen. (arbeite mit Office 365)
Beispiel:
Wenn in Spalte B eine 1 steht, dann schreib mir den Brief.....
Das Worddokument habe ich entsprechend erstellt, im selben Ordner hinterlegt, verknüpft etc....
Ich bin echter Newbie bei sowas und habe mich mal durchs Netz gewühlt und auch "etwas" hinbekommen.
Allerdings öffnet mir das VBA meinen Brief nur und befüllt diesen nicht.
Ich habe mit Sicherheit irgendwas übersehen, nur was ?
Code:
Sub fp_Excel_Word_Serienbrief_erstellen()
'-------------------------------------------
Dim ws As Worksheet
Set ws = ActiveSheet
Dim varRange As Excel.Range
'
'*pruefe, ob in der Spalte B ein Eintrag vorhanden ist
Dim intSendezeile As Integer
intSendezeile = 0
Dim intZeile As Integer
For intZeile = 1 To 1000
If ws.Range("B" & 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 B sind leer", vbCritical, "fp_Excel_Word_Serienbrief_erstellen()"
Exit Sub
End If
' Kontrolle >
'*diese Funktion oeffnet den Serienbrief BR-Mitteilung
Dim sFilename As String
sFilename = ThisWorkbook.Path & "\" & Names("varSerienbrief_Master_Filename").RefersToRange.Value
'
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 docx As Object
Dim docx As Word.Document 'word-dll
Set docx = CreateObject("Word.Document")
Set docx = 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 = ThisWorkbook.FullName
'
'*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 >-
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()"
End If
' Serienbrief erzeugen >
'-------------------------------------------
End Sub