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

Mails via VBA Makro aus Excel mit Anhang versenden

Frage Microsoft Microsoft Office

Mitglied: ExxiSt

ExxiSt (Level 1) - Jetzt verbinden

21.10.2014, aktualisiert 10:36 Uhr, 3579 Aufrufe, 2 Kommentare

Hallo zusammen,

hoffe es kann mir jemand bei folgendem Problem helfen. Ich hänge hier nun schon seit Tagen fest und komme einfach nicht weiter...

Mit diesem Makro sollen Mails mit einer Excel Datei im Anhang versendet werden. Der Inhalt des Anhangs soll ein separates Tabellenblatt sein, in welches die Werte aus dem "Master"-Tabellenblatt kopiert werden, wenn folgende Bedingungen erfüllt sind:

1. Inhalte einer Zeile werden nur dann kopiert, wenn in Spalte U eine "versenden" steht
2. Es sollen, wenn diese Bedingung zutrifft, nur die Spalten A bis M sowie die Spalte R kopiert werden.

Der Mailversand funktioniert einwandfrei. Das Problem liegt wohl bei der Definition des Bereichs, der kopiert werden soll. (Ab Code Zeile 30)

Weiter unten werden die Mails dann noch nach "Mailadresse" zusammengefasst, sodass pro Mailadresse nur eine Mail rausgeht. Aber auch das funktioniert.

Folgend der Code.

Vielen Dank vorab und Grüße
Sascha

01.
Sub Mails_versenden() 
02.
03.
04.
' Tastenkombination: Strg+b 
05.
06.
If MsgBox("Sollen die Anschreiben nun versendet werden?", vbYesNo) <> vbYes Then Exit Sub 
07.
  
08.
          
09.
 Dim ws As Worksheet, rngSource As Range, dic As Object, c As Range, firstAddress As String, cell As Range 
10.
    'Dictionary Objekt erzeugen indem wir die bereits bearbeiteten Zeilen hinterlegen 
11.
    Dim MyMessage As Object, MyOutApp As Object 
12.
    Dim SavePath As String 
13.
    Dim AWS As String 
14.
    Dim Rng2Copy As Range, Rng2Paste As Range 
15.
    Dim aWerte() 
16.
    Dim i As Long 
17.
    Dim x As Integer 
18.
     
19.
    Application.ScreenUpdating = False 
20.
     
21.
     
22.
     
23.
    For i = Cells(Rows.Count, 1).End(xlUp).Row To 1 Step -1 
24.
     
25.
    'Spalte U=versenden 
26.
     
27.
    If Cells(i, 21) = "versenden" Then 
28.
         
29.
     
30.
       'Bereich Aus Mastertabellenblatt in neues Tabellenblatt 
31.
 
32.
    Rng2Copy = Sheets("Master").Range(Cells(i, 1), Cells(i, 13)) 
33.
    Set Rng2Paste = Sheets("Überfüllte_versendet").Range(Cells(i, 1), Cells(i, 13)) 
34.
        aWerte() = Rng2Copy 
35.
        Rng2Paste = aWerte() 
36.
    Set Rng2Copy = Sheets("Master").Cells(i, 18) 
37.
    Set Rng2Paste = Sheets("Überfüllte_versendet").Cells(i, 18) 
38.
        aWerte() = Rng2Copy 
39.
        Rng2Paste = aWerte() 
40.
      
41.
 
42.
 
43.
     
44.
    End If 
45.
   Next i 
46.
      
47.
    Application.ScreenUpdating = True 
48.
      
49.
    
50.
 
51.
    SavePath = "H:\" '"E:\Eigene Dateien" 
52.
    'Kopiert Sheet "Überfüllte_versendet" in eine neue Mappe 
53.
    'welche nur diese Tabelle enthält 
54.
    Sheets("Überfüllte_versendet").Copy 
55.
    'Speichert die Datei unter dem Tabellennamen und einem Zeitstempel 
56.
    ActiveWorkbook.SaveAs SavePath & "\" & ActiveSheet.Name & "_" & Format(Now, "ddmmyyyy_hhmm") & ".xlsx" 
57.
    'Mappenname wird an Variable übergeben 
58.
    'und anschliessend gleich geschlossen 
59.
    With ActiveWorkbook 
60.
        AWS = .FullName 
61.
        .Close 
62.
    End With 
63.
     
64.
               
65.
    Set dic = CreateObject("Scripting.Dictionary") 
66.
    'Outlook-Objekt erzeugen 
67.
    Set objOL = CreateObject("Outlook.Application") 
68.
    'Tabellenblatt referenzieren 
69.
    Set ws = Worksheets("Master") 
70.
     
71.
    'belegter Range der Zeilen ermnitteln 
72.
    Set rngSource = ws.Range("A1", ws.Cells(Rows.Count, 1).End(xlUp)) 
73.
     
74.
    'Für jede Zeile im Range 
75.
    For Each cell In rngSource 
76.
        ' wenn die Zeile noch nicht bearbeitet wurde und in Spalte U eine "versenden" steht (20 = Spalte U) 
77.
        If Not dic.Exists(cell.Row) And cell.Offset(0, 20).Value = "versenden" Then 
78.
            Dim strMailBody 
79.
            'Mail erzeugen 
80.
            Set objMail = objOL.CreateItem(0) 
81.
            'Eigenschaften der Mail zuweisen 
82.
            objMail.Subject = "Bitte bereinigen. Danke" 
83.
            objMail.To = cell.Offset(0, 32).Value 
84.
            'Mailbody erzeugen aber noch nicht endgültig der Mail zuweisen 
85.
            objMailBody = cell.Offset(0, 33) & vbNewLine & vbNewLine & cell.Offset(0, 34).Value & vbNewLine 
86.
                          
87.
            'In Spalte "Mail" nach dem aktuellen Zellwert in Spalte Mail suchen 
88.
            With rngSource.Offset(cell.Row, 32) 
89.
                Set c = .Find(cell.Offset(0, 32).Value, LookIn:=xlValues, lookAt:=xlWhole) 
90.
                If Not c Is Nothing Then 
91.
                    firstAddress = c.Address 
92.
                    Do 
93.
                         ' Nur wenn in Spalte U "versenden" steht 
94.
                        If ws.Cells(c.Row, 21).Value = "versenden" Then 
95.
                            'bearbeitete Zeile zum Dictionary hinzufügen, so dass sie später nicht nochmal verwendet wird 
96.
                            If Not dic.Exists(c.Row) Then dic.Add c.Row, "" 
97.
                            'dem Mailbody den Inhalt von Spalte Z hinzufügen 
98.
                            strMailBody = strMailBody & c.Offset(0, 2) & vbNewLine 
99.
                            'nächste Fundstelle suchen 
100.
                    End If 
101.
                           Set c = .FindNext(c) 
102.
                    Loop While Not c Is Nothing And c.Address <> firstAddress 
103.
                      
104.
 
105.
                End If 
106.
                 
107.
            
108.
             
109.
            End With 
110.
             
111.
            
112.
              
113.
            'Mail zum testen nur anzeigen 
114.
            objMail.Display 
115.
          
116.
   objMail.Attachments.Add AWS 
117.
        
118.
             
119.
        End If 
120.
         
121.
    Next 
122.
 
123.
ActiveWorkbook.Save 
124.
 
125.
Kill AWS 
126.
'MsgBox "Anschreiben erfolgreich an Outlook übertragen!" 
127.
 
128.
 
129.
Sheets("Überfüllte_versendet").Cells.Clear 
130.
   
131.
End Sub 
132.
 
Mitglied: 116301
LÖSUNG 21.10.2014, aktualisiert um 10:36 Uhr
Hallo Sascha!

Das Kopieren der Versenden-Zeilen vom Sheet(Master) in das Sheets(Überfüllte_versendet) in etwa so:
01.
Private Sub test() 
02.
    Dim oWks As Worksheet 
03.
     
04.
    Set oWks = Sheets("Überfüllte_versendet") 
05.
     
06.
    oWks.UsedRange.Clear 
07.
     
08.
    With Sheets("Master") 
09.
        .AutoFilterMode = False 
10.
        .Columns("U:U").AutoFilter Field:=1, Criteria1:="=versenden", Operator:=xlAnd 
11.
        .Range(Replace("A1:M#,R1:R#", "#", .UsedRange.Rows.Count)).Copy oWks.Range("A1") 
12.
        .AutoFilterMode = False 
13.
    End With 
14.
End Sub
Wobei die Überschriftzeile(1) ebenfalls kopiert wird...

Grüße Dieter
Bitte warten ..
Mitglied: ExxiSt
21.10.2014 um 10:36 Uhr
Wahnsinn, funktioniert! Vielen Dank für die schnelle Hilfestellung!

Beste Grüße
Sascha
Bitte warten ..
Ähnliche Inhalte
Microsoft Office
VBA Makro Mails aus Excel versenden
gelöst Frage von ExxiStMicrosoft Office7 Kommentare

Guten Tag zusammen, folgendes Problem treibt mich schon seit Tagen zur Verzweiflung: Aus einer Excel Datei werden durch folgendes ...

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

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

Neue Wissensbeiträge
Windows 10

Windows 10 v1709 EN murkst bei den Regionseinstellungen

Tipp von DerWoWusste vor 3 StundenWindows 10

Dieser kurze Tipp richtet sich an den kleinen Personenkreis, der Win10 v1709 EN-US frisch installiert und dabei die englische ...

Webbrowser

Kein Ton bei Firefox Quantum über RDP

Tipp von Moddry vor 4 StundenWebbrowser

Hallo Kollegen! Hatte das Problem, dass der neue Firefox bei mir auf der Kiste keinen Ton hat, wenn ich ...

Internet

EU-DSGVO: WHOIS soll weniger Informationen liefern

Information von sabines vor 16 StundenInternet4 Kommentare

Wegen der europäische Datenschutzgrundverordnung stehen die Prozesse um die Registrierung von Domains auf dem Prüfstand. Sollte die Forderungen umgesetzt ...

Verschlüsselung & Zertifikate

19 Jahre alter Angriff auf TLS funktioniert immer noch

Information von BassFishFox vor 22 StundenVerschlüsselung & Zertifikate1 Kommentar

Interessant zu lesen. Der Bleichenbacher-Angriff gilt unter Kryptographen als Klassiker, trotzdem funktioniert er oft noch. Wie wir herausgefunden haben, ...

Heiß diskutierte Inhalte
LAN, WAN, Wireless
Von rj11 auf rj45
Frage von jensgebkenLAN, WAN, Wireless19 Kommentare

Hallo Gemeinschaft, könnt ihr mir vielleicht bei der anfertigung eines Kabels helfen - habe ein rj 11 stecker und ...

Netzwerkmanagement
NAS über zwei weitere Ethernet Anschlüsse verbinden
gelöst Frage von Sibelius001Netzwerkmanagement17 Kommentare

Sorry - ich bin hier wahrscheinlich als kompetter IT Trottel unterwegs. Aber eventuell kann mir jemand ganz einfach helfen: ...

Netzwerkmanagement
Firefox Profieles im Roaming
gelöst Frage von Hendrik2586Netzwerkmanagement17 Kommentare

Hallo liebe Leute. :) Ich hab da ein kleines Problem, welches anscheinend nicht unbekannt ist. Wir nutzen hier in ...

LAN, WAN, Wireless
Häufig Probleme beim Anmelden in WLAN
Frage von mabue88LAN, WAN, Wireless15 Kommentare

Hallo zusammen, in einem Netzwerk gibt es relativ häufig (1-2 mal pro Woche) Probleme mit der WLAN-Verbindung. Zunächst mal ...