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

VBA Makro Mails aus Excel versenden

Frage Microsoft Microsoft Office

Mitglied: ExxiSt

ExxiSt (Level 1) - Jetzt verbinden

26.08.2014 um 12:13 Uhr, 2088 Aufrufe, 7 Kommentare

Guten Tag zusammen,

folgendes Problem treibt mich schon seit Tagen zur Verzweiflung:

Aus einer Excel Datei werden durch folgendes Makro automatische Mails generiert.
Dies klappt soweit auch ohne Probleme. Allerdings soll folgendes mit eingebaut werden:

Für jede Zeile wird aktuell eine Mail generiert.
Allerdings sollen Zeilen in einer Mail zusammengeführt werden, wenn der Inhalt aus Spalte Y in den Zeilen gleich ist.
Der Mailtext soll zudem eine Zusammenfassung der betroffenen Zeilen aus Spalte Z darstellen

Gibt es hierzu eine mögliche Lösung?

Ich bin dankbar für jeden Tipp, der mich der Lösung näher bringt!


*
Sub Excel_Serial_Mail()

LetzteZeile = ActiveSheet.Cells(Rows.Count, 1).End(xlUp).Row

Dim MyOutApp As Object, MyMessage As Object
Dim i As Long
'Start der Sendeschleife an alle Empfänger bis letzte gefüllte Zeile erreicht ist.

For i = 1 To LetzteZeile

If (i / 2) = Int(i / 2) Then
If Cells(i, 3) = 1 Then

Set MyOutApp = CreateObject("Outlook.Application")
Set MyMessage = MyOutApp.CreateItem(0)
With MyMessage
'Die Empfänger stehen in Spalte B ab Zeile 1
'.To = Cells(i, 2) 'E-Mail Adresse
'Der Betreff in Spalte A
.Subject = Cells(i, 1) '"Betreffzeil"
'Der zu sendende Text in Spalte C
'Der Text wird ohne Formatierung übernommen
.Body = Cells(i, 2)
'Hier wird die Mail angezeigt
.Display


End With

'Objectvariablen leeren
Set MyOutApp = Nothing 'CreateObject("Outlook.Application")
Set MyMessage = Nothing 'MyOutApp.CreateItem(0)
'Sendepause einschalten
Application.Wait (Now + TimeValue("0:00:01"))

End If
End If
Next i
End Sub

*
Mitglied: colinardo
LÖSUNG 26.08.2014, aktualisiert 28.08.2014
Hallo ExxiSt, Willkommen auf Administrator.de!
Ich habe dir hier mal ein Demo-Sheet zusammengestellt, das das gewünschte macht, soweit ich deine Schilderung richtig interpretiert habe. Damit solltest du dein Vorhaben realisieren können. Weitere Kommentare befinden sich im Quellcode.

Grüße Uwe

p.s. Bitte nutze in Zukunft Code-Tags für deinen Quellcode: <code> Quellcode </code>. Merci.
Bitte warten ..
Mitglied: ExxiSt
26.08.2014 um 20:51 Uhr
Hallo Uwe,

sorry für die fehlenden Qode-Tags... bin erst seit heute auf administrator.de unterwegs und damit noch nicht ganz vertraut.

Bin immer noch ganz hin und weg von deiner schnellen Antwort!!!

Vielen Dank schon mal für die Datei! Ich werde sie hoffentlich schon morgen ausprobieren können und entsprechende Rückmeldung geben.

Schönen Abend und Grüße
Sascha
Bitte warten ..
Mitglied: ExxiSt
27.08.2014 um 16:31 Uhr
Hallo Uwe,

deine Datei hat wunderbar funktioniert - der Wahnsinn, genau was ich sucht habe!
Allerdings beiße ich mir gerade noch die Zähne an folgenden zwei Dingen aus. Gibt es hierfür eine Lösung?

Es sollen ausschließlich die Zeilen berücksichtigt werden, bei welchen in Spalte D eine 1 steht.
Außerdem habe ich auch Spaltenüberschriften verwendet, die nicht als Mail ausgegeben werden sollen. Wenn ich aber einfach ab A2 statt A1 zu zählen beginne, bekomme ich eine Fehlermeldung bei dic.Add c.Row, ""

Vielleicht gibt es hierfür ja eine Lösung. Vielen Dank vorab für deine Hilfestellungen!

Beste Grüße
Sascha

01.
Sub Aufträge_anschreiben() 
02.
03.
' Aufträge_anschreiben Makro 
04.
05.
' Tastenkombination: Strg+m 
06.
07.
    Dim ws As Worksheet, rngSource As Range, dic As Object, c As Range, firstAddress As String, cell As Range 
08.
    'Dictionary Objekt erzeugen indem wir die bereits bearbeiteten Zeilen hinterlegen 
09.
        
10.
    Set dic = CreateObject("Scripting.Dictionary") 
11.
    'Outlook-Objekt erzeugen 
12.
    Set objOL = CreateObject("Outlook.Application") 
13.
    'Tabellenblatt referenzieren 
14.
    Set ws = Worksheets("Makro") 
15.
     
16.
    'belegter Range der Zeilen ermnitteln 
17.
    Set rngSource = ws.Range("A1", ws.Cells(Rows.Count, 1).End(xlUp)) 
18.
    'Für jede Zeile im Range 
19.
    For Each cell In rngSource 
20.
        ' wenn die Zeile noch nicht bearbeitet wurde 
21.
        If Not dic.Exists(cell.Row) Then 
22.
            Dim strMailBody 
23.
            'Mail erzeugen 
24.
            Set objMail = objOL.CreateItem(0) 
25.
            'Eigenschaften der Mail zuweisen 
26.
            objMail.Subject = "Auftragskorrektur, bitte nachfolgende Aufträge prüfen/bereinigen. Danke und Grüße VKK" 
27.
            objMail.To = cell.Offset(0, 2).Value 
28.
            'Mailbody erzeugen aber noch nicht endgültig der Mail zuweisen 
29.
            strMailBody = cell.Offset(0, 1) & vbNewLine & vbNewLine & cell.Offset(0, 0).Value & vbNewLine 
30.
             
31.
            'In Spalte "Sachbearbeiter" nach dem aktuellen Zellwert in Spalte Sachbearbeiter suchen 
32.
            With rngSource.Offset(cell.Row, 2) 
33.
                Set c = .Find(cell.Offset(0, 2).Value, LookIn:=xlValues, Lookat:=xlWhole) 
34.
                If Not c Is Nothing Then 
35.
                    firstAddress = c.Address 
36.
                    Do 
37.
                        'bearbeitete Zeile zum Dictionary hinzufügen, so dass sie später nicht nochmal verwendet wird 
38.
                        dic.Add c.Row, "" 
39.
                        'dem Mailbody den Inhalt von Spalte A hinzufügen 
40.
                        strMailBody = strMailBody & c.Offset(0, -2) & vbNewLine 
41.
                        'nächste Fundstelle suchen 
42.
                        Set c = .FindNext(c) 
43.
                    Loop While Not c Is Nothing And c.Address <> firstAddress 
44.
                End If 
45.
            End With 
46.
            'Mailbody der Mail zuweisen 
47.
            objMail.Body = strMailBody 
48.
            'Mail zum testen nur anzeigen 
49.
            objMail.Display 
50.
        End If 
51.
     
52.
     
53.
    Next 
54.
 
55.
 
56.
End Sub 
57.
 
Bitte warten ..
Mitglied: colinardo
LÖSUNG 27.08.2014, aktualisiert 28.08.2014
01.
Sub SortedMailing() 
02.
    Dim ws As Worksheet, rngSource As Range, dic As Object, c As Range, firstAddress As String, cell As Range, lastRow as Long 
03.
    'Dictionary Objekt erzeugen indem wir die bereits bearbeiteten Zeilen hinterlegen 
04.
    Set dic = CreateObject("Scripting.Dictionary") 
05.
    'Outlook-Objekt erzeugen 
06.
    Set objOL = CreateObject("Outlook.Application") 
07.
    'Tabellenblatt referenzieren 
08.
    Set ws = Worksheets(1) 
09.
    'belegter Range der Zeilen ermnitteln 
10.
    Set rngSource = ws.Range("A2", ws.Cells(Rows.Count, 1).End(xlUp)) 
11.
    lastRow = rngSource.Cells(rngSource.Rows.Count, 1).Row 
12.
    'Für jede Zeile im Range 
13.
    For Each cell In rngSource 
14.
        ' wenn die Zeile noch nicht bearbeitet wurde und in Spalte D eine 1 steht 
15.
        If Not dic.Exists(cell.Row) And cell.Offset(0, 3).Value = 1 Then 
16.
            Dim strMailBody 
17.
            'Mail erzeugen 
18.
            Set objMail = objOL.CreateItem(0) 
19.
            'Eigenschaften der Mail zuweisen 
20.
            objMail.Subject = cell.Value 
21.
            objMail.To = cell.Offset(0, 1).Value 
22.
            'Mailbody erzeugen aber noch nicht endgültig der Mail zuweisen 
23.
            strMailBody = cell.Offset(0, 2).Value & vbNewLine 
24.
             
25.
            'In Spalte Y nach dem aktuellen Zellwert in Spalte Y suchen 
26.
            With ws.Range(ws.Cells(cell.Row + 1, 25), ws.Cells(lastRow, 25)) 
27.
                Set c = .Find(ws.Cells(cell.Row, 25).Value, LookIn:=xlValues, Lookat:=xlWhole) 
28.
                If Not c Is Nothing Then 
29.
                    firstAddress = c.Address 
30.
                    Do 
31.
                        ' Nur wenn in Spalte D eine 1 steht 
32.
                        If ws.Cells(c.Row, 4).Value = 1 Then 
33.
                            'bearbeitete Zeile zum Dictionary hinzufügen, so dass sie später nicht nochmal verwendet wird 
34.
                            If Not dic.Exists(c.Row) Then dic.Add c.Row, "" 
35.
                            'dem Mailbody den Inhalt von Spalte Z hinzufügen 
36.
                            strMailBody = strMailBody & c.Offset(0, 1) & vbNewLine 
37.
                            'nächste Fundstelle suchen 
38.
                        End If 
39.
                        Set c = .FindNext(c) 
40.
                    Loop While Not c Is Nothing And c.Address <> firstAddress 
41.
                End If 
42.
            End With 
43.
            'Mailbody der Mail zuweisen 
44.
            objMail.Body = strMailBody 
45.
            'Mail zum testen nur anzeigen 
46.
            objMail.Display 
47.
        End If 
48.
    Next 
49.
End Sub
Grüße Uwe
Bitte warten ..
Mitglied: ExxiSt
28.08.2014 um 08:02 Uhr
Guten Morgen Uwe,

das
01.
 Set rngSource = ws.Range("A2", ws.Cells(Rows.Count, 1).End(xlUp)) 
hatte ich genauso gelöst, allerdings poppt mir hier immer die Fehlermeldung bei Zeile 33 auf: "Laufzeitfehler '457': Dieser Schlüssel ist bereits in einem Element dieser AUflistung zugeordnet"...
Die bekomme ich einfach nicht weg!

Grüße
Sascha
Bitte warten ..
Mitglied: ExxiSt
28.08.2014 um 08:15 Uhr
PROBLEM GELÖST!!

Hallo Uwe,

mir ist aufgefallen, dass ich
01.
 Set rngSource = ws.Range("A2", ws.Cells(Rows.Count, 1).End(xlUp)) 
gar nicht in
01.
 Set rngSource = ws.Range("A1", ws.Cells(Rows.Count, 1).End(xlUp)) 
umbenennen muss, da Zeile 1 schon durch folgende Bedingung ausgeschlossen wird:
01.
 If ws.Cells(c.Row, 4).Value = 1 Then  


Somit erscheint auch nicht die Fehlermeldung und der Code ist für mich perfekt.

Danke vielmals für deine Bemühungen!

Grüße
Sascha
Bitte warten ..
Mitglied: colinardo
28.08.2014 um 09:35 Uhr
Moin Sascha,
ich hatte vergessen den Suchbereich nach unten hin zu verkleinern, sorry, ist jetzt oben gefixt.

Grüße Uwe
Bitte warten ..
Ähnliche Inhalte
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 ...

Microsoft Office
Excel Makro VBA Sortierung nach Spaltennamen
gelöst Frage von easy4breezyMicrosoft Office3 Kommentare

Hi Leute, ich habe mich hier schon eingelesen und auch im Internet, aber irgendwie komme ich zu keiner Lösung ...

Microsoft Office
Email aus Excel 2010 mit VBa versenden
gelöst Frage von GundelputzMicrosoft Office8 Kommentare

Hallo da draussen, ich möchte in Excel 2010 eine Email versenden die nur einen Betreff und eine Textnachricht enthält. ...

Outlook & Mail
Mails via VBA Makro aus Excel mit Anhang versenden - an verschiedene Empfänger, aber pro Empfänger nur max. eine Mail
Frage von JanZieglerSchulzOutlook & Mail

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

Neue Wissensbeiträge
Windows 10

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

Tipp von kgborn vor 1 TagWindows 107 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 1 TagSicherheits-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?
Frage von HelloWorldBatch & Shell18 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 ...

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 > ...

Windows 10
Autsch: Microsoft bündelt Windows 10 mit unsicherer Passwort-Manager-App
Tipp von kgbornWindows 107 Kommentare

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