Top-Themen

Aktuelle Themen (A bis Z)

Administrator.de FeedbackApache ServerAppleAssemblerAudioAusbildungAuslandBackupBasicBatch & ShellBenchmarksBibliotheken & ToolkitsBlogsCloud-DiensteClusterCMSCPU, RAM, MainboardsCSSC und C++DatenbankenDatenschutzDebianDigitiales FernsehenDNSDrucker und ScannerDSL, VDSLE-BooksE-BusinessE-MailEntwicklungErkennung und -AbwehrExchange ServerFestplatten, SSD, RaidFirewallFlatratesGoogle AndroidGrafikGrafikkarten & MonitoreGroupwareHardwareHosting & HousingHTMLHumor (lol)Hyper-VIconsIDE & EditorenInformationsdiensteInstallationInstant MessagingInternetInternet DomäneniOSISDN & AnaloganschlüsseiTunesJavaJavaScriptKiXtartKVMLAN, WAN, WirelessLinuxLinux DesktopLinux NetzwerkLinux ToolsLinux UserverwaltungLizenzierungMac OS XMicrosoftMicrosoft OfficeMikroTik RouterOSMonitoringMultimediaMultimedia & ZubehörNetzwerkeNetzwerkgrundlagenNetzwerkmanagementNetzwerkprotokolleNotebook & ZubehörNovell NetwareOff TopicOpenOffice, LibreOfficeOutlook & MailPapierkorbPascal und DelphiPeripheriegerätePerlPHPPythonRechtliche FragenRedHat, CentOS, FedoraRouter & RoutingSambaSAN, NAS, DASSchriftartenSchulung & TrainingSEOServerServer-HardwareSicherheitSicherheits-ToolsSicherheitsgrundlagenSolarisSonstige SystemeSoziale NetzwerkeSpeicherkartenStudentenjobs & PraktikumSuche ProjektpartnerSuseSwitche und HubsTipps & TricksTK-Netze & GeräteUbuntuUMTS, EDGE & GPRSUtilitiesVB for ApplicationsVerschlüsselung & ZertifikateVideo & StreamingViren und TrojanerVirtualisierungVisual StudioVmwareVoice over IPWebbrowserWebentwicklungWeiterbildungWindows 7Windows 8Windows 10Windows InstallationWindows MobileWindows NetzwerkWindows ServerWindows SystemdateienWindows ToolsWindows UpdateWindows UserverwaltungWindows VistaWindows XPXenserverXMLZusammenarbeit
GELÖST

Excel Serienbrief VBA mit Standardtext und Anhang

Frage Microsoft Microsoft Office

Mitglied: xfiles

xfiles (Level 1) - Jetzt verbinden

22.01.2014 um 17:40 Uhr, 3825 Aufrufe, 5 Kommentare, 2 Danke

Hallo Leute,

ich habe folgendes Problem:

Ich habe eine Excel Datei mit mehreren Mail Adressen.
Diese sollen alle eine Mail erhalten mit jeweils einem Standardtext und Standard Betreff.
Der Text und Betreff ist für alle Empfänger der gleiche.
Soweit so gut. Habe ich noch hinbekommen (zumindest an eine Adresse).
Nun soll jedem Empfänger (jeder Mail-Adresse) ein individueller Anhang (PDF) angehängt werden.
Dies übersteigt meine VBA Kenntnisse leider völligst.

Wie schicke ich die Mail an alle Adressen von Spalte AD2 bis AD_letzer Wert?
Wie verknüpfe ich jeweils eine PDF Datei mit einer der vorhandenen Mails?

Bisher sieht mein Skript folgt aus (funktioniert auch: schickt dem Empfänger aus AD213 eine Mail mit Text und Betreff und der angehängten Datei "Datei.txt"):

Sub LotusMail(Empfaenger As String, Dateianhang As String, Inhalt As String)
Dim Kopie_Empfänger As String, BlindKopie_Empfänger As String, Betreff As String

Const EMBED_ATTACHMENT = 1454
Dim server As String, mailfile As String
Dim session As Object
Dim DB As Object
Dim doc As Object
Dim rtitem As Object
Dim EmbeddedObject As Object

' Auslesen der Mail-DB
Set session = CreateObject("Notes.NotesSession")
server = session.GetEnvironmentString("MailServer", True)
mailfile = session.GetEnvironmentString("MailFile", True)
Set DB = session.GETDATABASE(server, mailfile)
Set doc = DB.CreateDocument()
doc.Form = "Main Topic"
doc.SendTo = Empfaenger ' Adressaten übergeben
' doc.CopyTo = Me.Kopie_Empfänger.Value
' doc.BlindCopyTo = Me.BlindKopie_Empfänger.Value
doc.Subject = "Standardbetreff!" ' Betreff hier festlegen
doc.Body = Inhalt
Dateianhang = "C:\Datei.txt"
Set rtitem = doc.CREATERICHTEXTITEM("ProjectDescription")
Set EmbeddedObject = rtitem.EMBEDOBJECT(EMBED_ATTACHMENT, "", Dateianhang) 'Dateianhang mit Pfad und Dateiname überschreiben
'doc.SIGN = "0"
'doc.ENCRYPT = "0"
'doc.BlindCopyTo = ""
'doc.DefaultMailSaveOptions = 0 '"1"
'doc.MailSaveOptions = 0 '"1"
'doc.DeliveryReport = "B"
'doc.MailOptions = "2" '"0"/*-*--*//**/
'doc.Importance = "1" ' Neu
'doc.logo = "Barmenia" 'neu
'doc.ReturnReceipt = "1"
doc.principal = session.UserName
doc.viewicon = "75"
doc.FROM = session.UserName ' Von Zeile = Aktueller Benutzer
' doc.SaveOptions = 0 '"1"
' doc.SecureMail = ""
' doc.SenderTag = "F"

'SMTP-Originator
doc.PostedDate = Format$(Now, "dd.mm.yyyy") + " " + Format$(Now, "hh:nn:ss")
' doc.SAVEMESSAGEONSEND = 0
' Call doc.Save(False, False)
Call doc.Send(True, "")
Set doc = Nothing
Set DB = Nothing
End Sub

Sub Mail_Senden()
Dim Cell As Range
Call LotusMail(Range("AD213"), "", "Standardtext")

'Für jede Zelle in Bereich d2 bis zur letzen belegten Zelle in Spalte d wird eine Mail versandt.
' For Each Cell In Range("AD213:AD" & Cells(Rows.Count, "AD").End(xlUp).Row)
' If Cell <> "" Then Call LotusMail(Cell.Value, "", Cell(1, -2) & " " & Cell(1, -1) & " " & Cell(1, 0) & "," & Range("g2").Text & Cell(1, 2) & Range("h2").Text)
' Next
End Sub
Gibt es für so eine Anwendung evtl. auch Freeware?


Grüße

xfiles
Mitglied: colinardo
22.01.2014, aktualisiert um 18:28 Uhr
Hallo xfiles,
also LotusMail habe ich jetzt nicht hier zum testen aber so sollte es laufen, wenn du die Pfade zu den Anhängen in der Zelle jeweils rechts neben der E-Mail-Adresse in Spalte AE platzierst. Den Namen deines Sheets musst du in Zeile 55 noch eintragen.
01.
Sub LotusMail(ByVal Empfaenger As String, ByVal Dateianhang As String, ByVal Betreff As String, ByVal Inhalt As String) 
02.
 
03.
    Dim Kopie_Empfänger As String, BlindKopie_Empfänger As String 
04.
     
05.
    Const EMBED_ATTACHMENT = 1454 
06.
    Dim server As String, mailfile As String 
07.
    Dim session As Object 
08.
    Dim DB As Object 
09.
    Dim doc As Object 
10.
    Dim rtitem As Object 
11.
    Dim EmbeddedObject As Object 
12.
     
13.
    ' Auslesen der Mail-DB 
14.
    Set session = CreateObject("Notes.NotesSession") 
15.
    server = session.GetEnvironmentString("MailServer", True) 
16.
    mailfile = session.GetEnvironmentString("MailFile", True) 
17.
    Set DB = session.GETDATABASE(server, mailfile) 
18.
    Set doc = DB.CreateDocument() 
19.
    doc.Form = "Main Topic" 
20.
    doc.SendTo = Empfaenger ' Adressaten übergeben 
21.
    ' doc.CopyTo = Me.Kopie_Empfänger.Value 
22.
    ' doc.BlindCopyTo = Me.BlindKopie_Empfänger.Value 
23.
    doc.Subject = Betreff 
24.
    doc.Body = Inhalt 
25.
    Set rtitem = doc.CREATERICHTEXTITEM("ProjectDescription") 
26.
    Set EmbeddedObject = rtitem.EMBEDOBJECT(EMBED_ATTACHMENT, "", Dateianhang) 'Dateianhang mit Pfad und Dateiname überschreiben 
27.
    'doc.SIGN = "0" 
28.
    'doc.ENCRYPT = "0" 
29.
    'doc.BlindCopyTo = "" 
30.
    'doc.DefaultMailSaveOptions = 0 '"1" 
31.
    'doc.MailSaveOptions = 0 '"1" 
32.
    'doc.DeliveryReport = "B" 
33.
    'doc.MailOptions = "2" '"0"/*-*--*//**/ 
34.
    'doc.Importance = "1" ' Neu 
35.
    'doc.logo = "Barmenia" 'neu 
36.
    'doc.ReturnReceipt = "1" 
37.
    doc.principal = session.UserName 
38.
    doc.viewicon = "75" 
39.
    doc.FROM = session.UserName ' Von Zeile = Aktueller Benutzer 
40.
    ' doc.SaveOptions = 0 '"1" 
41.
    ' doc.SecureMail = "" 
42.
    ' doc.SenderTag = "F" 
43.
     
44.
    'SMTP-Originator 
45.
    doc.PostedDate = Format$(Now, "dd.mm.yyyy") + " " + Format$(Now, "hh:nn:ss") 
46.
    ' doc.SAVEMESSAGEONSEND = 0 
47.
    ' Call doc.Save(False, False) 
48.
    Call doc.Send(True, "") 
49.
    Set doc = Nothing 
50.
    Set DB = Nothing 
51.
End Sub 
52.
 
53.
Sub Mail_Senden() 
54.
    Dim sheet As Worksheet, rngStart As Range, rngEnd As Range, cell As Range 
55.
    Set sheet = Worksheets("Tabelle1") 
56.
    Set rngStart = sheet.Range("AD2") 
57.
    Set rngEnd = rngStart.End(xlDown) 
58.
    For Each cell In Range(rngStart, rngEnd) 
59.
        If cell.Value <> "" Then 
60.
            Anhang = cell.Offset(0, 1).Value 
61.
            LotusMail cell.Value, Anhang, "Standardbetreff!", "Standardbody" 
62.
        End If 
63.
    Next 
64.
End Sub
Grüße Uwe
Bitte warten ..
Mitglied: xfiles
22.01.2014 um 18:26 Uhr
Hallo und vielen vielen Dank schon mal für deine große Hilfe.
Ich bekomme leider noch einen Fehler ausgegeben:

Fehler beim Kompilieren: Argumenttyp ByRef unverträglich

Ich bin wahrscheinlich nur zu doof damit was anzufangen.
Und wo/wie definiere ich in VBA, dass der Anhang in Zelle AExxx liegt?

Gruß
Bitte warten ..
Mitglied: colinardo
22.01.2014 um 18:31 Uhr
Zitat von xfiles:
Fehler beim Kompilieren: Argumenttyp ByRef unverträglich
ist korrigiert.
Ich bin wahrscheinlich nur zu doof damit was anzufangen.
Und wo/wie definiere ich in VBA, dass der Anhang in Zelle AExxx liegt?
in Zeile 60 wird jeweils ein Offset zur aktuellen Zelle mit der E-Mail-Adresse definiert
Anhang = cell.Offset(0, 1).Value 
also ein Offset von einer Spalte nach Rechts von der aktuellen Zelle (erste Zahl = Zeilen-Offset , zweite Zahl Spalten-Offset)
Bitte warten ..
Mitglied: xfiles
23.01.2014 um 11:17 Uhr
Index außerhalb des gültigen Bereichs

Was mach ich falsch?

Danke für deine Mühe
Bitte warten ..
Mitglied: colinardo
23.01.2014, aktualisiert um 11:39 Uhr
Zitat von xfiles:

Index außerhalb des gültigen Bereichs

Was mach ich falsch?
meine Glaskugel kann leider nicht in deinen von dir geänderten Code und in dein Sheet schauen, da wird es schwer so ohne weitere Info deinerseits eine Diagnose zu stellen ...
Bitte warten ..
Ähnliche Inhalte
Microsoft Office
VBA Excel Makro - Serienbrief in Word aus Excel starten und anschließen einzeln speichern
gelöst Frage von abuelitoMicrosoft Office5 Kommentare

Hallo an Alle, ich möchte gerne aus Excel heraus mein Serienbrief starten und die Briefe einzeln speichern. Das bedeutet, ...

Microsoft Office
Mails via VBA Makro aus Excel mit Anhang versenden
gelöst Frage von ExxiStMicrosoft Office2 Kommentare

Hallo zusammen, hoffe es kann mir jemand bei folgendem Problem helfen. Ich hänge hier nun schon seit Tagen fest ...

VB for Applications
Einzelne PDFs aus Serienbrief an neue Email anhängen
Frage von onkelsibbVB for Applications1 Kommentar

Hallo Leute, Ich habe folgendes vor: Ich habe einen Serienbrief, der seine Daten aus einer Excel-Tabelle bezieht. Nun soll ...

VB for Applications
Outlook VBA - Anhang autom. speichern
gelöst Frage von sokraTonisVB for Applications8 Kommentare

Hallo, ich bekomme an eine bestimmte E-Mail-Adresse immer wieder Nachrichten mit einem Anhang. Der Name vom Anhang ist immer ...

Neue Wissensbeiträge
Windows 10

Autsch: Microsoft bündelt Windows 10 mit unsicherer Passwort-Manager-App

Tipp von kgborn vor 2 TagenWindows 106 Kommentare

Unter Microsofts Windows 10 haben Endbenutzer keine Kontrolle mehr, was Microsoft an Apps auf dem Betriebssystem installiert (die Windows ...

Sicherheits-Tools

Achtung: Sicherheitslücke im FortiClient VPN-Client

Tipp von kgborn vor 2 TagenSicherheits-Tools

Ich weiß nicht, wie häufig die NextGeneration Endpoint Protection-Lösung von Fortinet in deutschen Unternehmen eingesetzt wird. An dieser Stelle ...

Internet

USA: Die FCC schaff die Netzneutralität ab

Information von Frank vor 2 TagenInternet5 Kommentare

Jetzt beschädigt US-Präsident Donald Trump auch noch das Internet. Der neu eingesetzte FCC-Chef Ajit Pai ist bekannter Gegner einer ...

DSL, VDSL

ALL-BM200VDSL2V - Neues VDSL-Modem mit Vectoring von Allnet

Information von Lochkartenstanzer vor 2 TagenDSL, VDSL2 Kommentare

Moin, Falls jemand eine Alternative zu dem draytek sucht: Gruß lks

Heiß diskutierte Inhalte
Batch & Shell
Kann man mit einer .txt Datei eine .bat Datei öffnen?
gelöst Frage von HelloWorldBatch & Shell20 Kommentare

Wie schon im Titel beschrieben würde ich gerne durch einfaches klicken auf eine Text oder Word Datei eine Batch ...

Router & Routing
OpenWRT bzw. L.E.D.E auf Buffalo WZR-HP-AG300H - update
gelöst Frage von EpigeneseRouter & Routing11 Kommentare

Guten Tag, ich habe auf einem Buffalo WZR-HP-AG300H die alternative Firmware vom L.E.D.E Projekt geflasht. Ich bin es von ...

LAN, WAN, Wireless
WLAN Reichweite erhöhen mit neuer Antenne
gelöst Frage von gdconsultLAN, WAN, Wireless9 Kommentare

Hallo, ich besitze einen TL-WN722N USB-WLAN Dongle mit einer richtigen Antenne. Ich frage mich jetzt ob man die Reichweite ...

Windows Server
Ping auf einen bestimmten Server nicht möglich
gelöst Frage von a.thierWindows Server7 Kommentare

Hallo, ich habe folgendes Problem. srv-dc1: Ping srv-nav > geht Ping srv-exchange > geht nicht srv-exchange: Ping srv-dc1 > ...