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

Mitglied: ExxiSt

ExxiSt (Level 1) - Jetzt verbinden

21.10.2014, aktualisiert 10:36 Uhr, 3760 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
Zero-Day-Lücke in Microsoft Edge
Information von kgborn vor 11 StundenWindows 10

In Microsofts Edge-Browser klafft wohl eine nicht geschlossene (0-Day) Sicherheitslücke im Just In Time Compiler (JIT Compiler) für Javascript. ...

Sicherheit
Microsoft und Skype: Sicherheit
Information von kgborn vor 12 StundenSicherheit

Die Tage gab es ja einige Berichte zur Sicherheit des Skype-Updaters. Der Updater von Skype läuft unter dem Konto ...

Datenschutz

Behörden ignorieren Sicherheitsbedenken gegenüber Windows 10

Information von Penny.Cilin vor 1 TagDatenschutz8 Kommentare

Hallo, passend zum Thema Ablösung LIMUX in München ein Beitrag bei Heise (siehe Link folgend). Behörden ignorieren Sicherheitsbedenken gegenüber ...

Sicherheit
Information Security Hub Munich airport
Information von brammer vor 1 TagSicherheit

Hallo, Neues Center für Cyber Kriminalität am Münchener Flughafen brammer

Heiß diskutierte Inhalte
Exchange Server
Exchange Postfach Einbindung Betriebs-rat -Arzt, Bewerbung .
gelöst Frage von YellowcakeExchange Server23 Kommentare

Hey ich habe da mal eine Denksport Aufgabe bekommen Genutzt wird ein Exchange Server 2010. hier gibt es den ...

Windows Server
Downgrade von Windows Server 2016 auf 2012 - Wie vorgehen?
Frage von EstefaniaWindows Server13 Kommentare

Guten Ich habe eine Frage an Erfahrene unter euch. Durch einen InPlace Upgrade wurde Windows Server 2012 auf die ...

Datenschutz
Telematikinfrastruktur Erfahrungsaustausch
Frage von MOS6581Datenschutz12 Kommentare

Moin, unter meinen Kunden befinden sich auch einige Ärzte, welche sich künftig mit der Telematikinfrastruktur-Geschichte der Gematik herumärgern dürfen. ...

Windows Server
Delgegierte OU via RDP verwalten - Objektverwaltung zuweisen
gelöst Frage von TOAOICEWindows Server12 Kommentare

Hallo, ich habe folgendes Problem. Ich möchte in meiner Domäne (Server2016), einer Gruppe (OUAdmin) Berechtigungen auf die OU Test ...