Thema Datum  Von Nutzer Rating
Antwort
Rot Makro Serienbrief PDF - Serienmail
28.01.2022 08:00:49 Anna
NotSolved
28.01.2022 08:58:47 volti
NotSolved

Ansicht des Beitrags:
Von:
Anna
Datum:
28.01.2022 08:00:49
Views:
948
Rating: Antwort:
  Ja
Thema:
Makro Serienbrief PDF - Serienmail

Hallo zusammen,

ich suche nach einem Makro (bzw. eine Erweiterung zu meinem aktuellen) in: Word/Excel, O365, Windows 10 (Enterprise)

Worum geht es genau?
Mein aktuelles Makro erstellt einzelne PDF Dateien aus einem Serienbrief und versehrt sieh mit einem neuen Dateinamen (Ordner_Name_Vorname).

Das ist notwendig für eine vereinfachte Ablage. Das Makro läuft sauber durch
Wo liegt das Problem?
Nun müssen diese Serienbriefe zusätzlich als Mail versendet werden.

Aktueller Stand: Habe ich zwei Makros. Eins in Excel für die Serienmail und eins in Word für die PDF Erstellung.
Aber das muss doch irgendwie sauber gehen... 

Hat jemand eine Idee? 

Excel Word
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
Public Sub Create_Mail_Send()
 
' Aufbau: Emailadresse, Bereff, Text direkt in Zellen nebeneinander
' Nur die Spalte mit der Emailadresse markieren und Makro starten.
 
 
    Dim objOutlook As Object
    Dim objMail As Object
     
    Dim EMAILADRESSE, BETREFF, TEXTINHALT As String
     
 
For Each zelle In Selection.Cells
     
    Set objOutlook = CreateObject("Outlook.Application")
    Set objMail = objOutlook.CreateItem(0)
 
'zelle.Activate
 
EMAILADRESSE = zelle.Value
BETREFF = zelle.Offset(0, 1).Value
TEXTINHALT = zelle.Offset(0, 2).Value
 
'MsgBox EMAILADRESSE & " " & " " & BETREFF & " " & TEXTINHALT
     
   With objMail
.SentOnBehalfOfName = "personalservice@stromnetz-berlin.de" 'hier die Absender-Emailadresse hinzufügen
.To = EMAILADRESSE
'.getinspector
'.cc =
.Subject = BETREFF
.Body = TEXTINHALT
.send
'.Display
End With
 
    Set objMail = Nothing
    Set objOutlook = Nothing
 
 
Next zelle
 
End Sub
 
Public Sub Create_Mail_show()
 
 
 
' Aufbau: Emailadresse, Bereff, Text direkt in Zellen nebeneinander
' Nur die Spalte mit der Emailadresse markieren und Makro starten.
 
 
 
 
Dim objOutlook As Object
Dim objMail As Object
 
Dim EMAILADRESSE, BETREFF, TEXTINHALT As String
 
 
 
For Each zelle In Selection.Cells
 
Set objOutlook = CreateObject("Outlook.Application")
Set objMail = objOutlook.CreateItem(0)
 
 
 
'zelle.Activate
 
 
 
EMAILADRESSE = zelle.Value
BETREFF = zelle.Offset(0, 1).Value
TEXTINHALT = zelle.Offset(0, 2).Value
 
 
 
'MsgBox EMAILADRESSE & " " & " " & BETREFF & " " & TEXTINHALT
 
With objMail
.SentOnBehalfOfName = "personalservice@stromnetz-berlin.de" 'hier die Absender-Emailadresse hinzufügen
.To = EMAILADRESSE
.getinspector
'.cc =
.Subject = BETREFF
.Body = TEXTINHALT
'.send
.Display
End With
 
 
Set objMail = Nothing
Set objOutlook = Nothing
 
 
 
Next zelle
 
 
End Sub

 

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
Option Explicit
 
Sub Serienbrief_im_PDF_Format_speichern()
' set variables
Dim iBrief As Integer, sBrief As String
Dim AppShell As Object
Dim BrowseDir As Variant
Dim Path As String
Dim Ordnerbenennung As Variant
' catch any errors
On Error GoTo ErrorHandling
' determine path
Set AppShell = CreateObject("Shell.Application")
Set BrowseDir = AppShell.BrowseForFolder(0, "Speicherort für Serienbriefe auswählen", 0, 16)
If BrowseDir = "Desktop" Then
Path = CreateObject("WScript.Shell").SpecialFolders("Desktop")
Else
Path = BrowseDir.items().Item().Path
End If
If Path = "" Then GoTo ErrorHandling
Ordnerbenennung = InputBox("Geben Sie den Ordnernamen ein:")
Path = Path & "\" & Ordnerbenennung & "\"
MkDir Path
On Error GoTo ErrorHandling
' hide application for better performance
MsgBox "Serienbriefe werden exportiert. Dieser Vorgang kann einige Minuten dauern - Microsoft Word wird während dieser Zeit ausgeblendet", vbOKOnly + vbInformation
Application.Visible = False
' create bulkletter and export as pdf
With ActiveDocument.MailMerge
.DataSource.ActiveRecord = 1
Do
.Destination = wdSendToNewDocument
.SuppressBlankLines = True
With .DataSource
.FirstRecord = .ActiveRecord
.LastRecord = .ActiveRecord
sBrief = Path & Ordnerbenennung & "_" & .DataFields("Name").Value & "_" & .DataFields("Vorname").Value & ".pdf"
End With
.Execute Pause:=False
If .DataSource.DataFields("Name").Value > "" Then
ActiveDocument.SaveAs FileName:=sBrief, FileFormat:=wdFormatPDF
End If
ActiveDocument.Close False
If .DataSource.ActiveRecord < .DataSource.RecordCount Then
.DataSource.ActiveRecord = wdNextRecord
Else
Exit Do
End If
Loop
End With
' error handling
ErrorHandling:
Application.Visible = True
If Err.Number = 76 Then
MsgBox "Der ausgewählte Speicherort ist ungültig", vbOKOnly + vbCritical
ElseIf Err.Number = 5852 Then
MsgBox "Das Dokument ist kein Serienbrief"
ElseIf Err.Number = 4198 Then
MsgBox "Der ausgewählte Speicherort ist ungültig", vbOKOnly + vbCritical
ElseIf Err.Number = 91 Then
MsgBox "Exportieren von Serienbriefen abgebrochen", vbOKOnly + vbExclamation
ElseIf Err.Number > 0 Then
MsgBox "Unbekannter Fehler: " & Err.Number & " - Bitte Makro erneut ausführen.", vbOKOnly + vbCritical
Else
MsgBox "Serienbriefe erfolgreich exportiert", vbOKOnly + vbInformation
End If
End Sub

 

 


Ihre Antwort
  • Bitte beschreiben Sie Ihr Problem möglichst ausführlich. (Wichtige Info z.B.: Office Version, Betriebssystem, Wo genau kommen Sie nicht weiter)
  • Bitte helfen Sie ebenfalls wenn Ihnen geholfen werden konnte und markieren Sie Ihre Anfrage als erledigt (Klick auf Häckchen)
  • Bei Crossposting, entsprechende Links auf andere Forenbeiträge beifügen / nachtragen
  • Codeschnipsel am besten über den Code-Button im Text-Editor einfügen
  • Die Angabe der Emailadresse ist freiwillig und wird nur verwendet, um Sie bei Antworten auf Ihren Beitrag zu benachrichtigen
Thema: Name: Email:



  • Bitte beschreiben Sie Ihr Problem möglichst ausführlich. (Wichtige Info z.B.: Office Version, Betriebssystem, Wo genau kommen Sie nicht weiter)
  • Bitte helfen Sie ebenfalls wenn Ihnen geholfen werden konnte und markieren Sie Ihre Anfrage als erledigt (Klick auf Häckchen)
  • Bei Crossposting, entsprechende Links auf andere Forenbeiträge beifügen / nachtragen
  • Codeschnipsel am besten über den Code-Button im Text-Editor einfügen
  • Die Angabe der Emailadresse ist freiwillig und wird nur verwendet, um Sie bei Antworten auf Ihren Beitrag zu benachrichtigen

Thema Datum  Von Nutzer Rating
Antwort
Rot Makro Serienbrief PDF - Serienmail
28.01.2022 08:00:49 Anna
NotSolved
28.01.2022 08:58:47 volti
NotSolved