Top-Themen

AppleEntwicklungHardwareInternetLinuxMicrosoftMultimediaNetzwerkeOff TopicSicherheitSonstige SystemeVirtualisierungWeiterbildungZusammenarbeit

Aktuelle Themen

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, 2691 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: Eintagsfliege
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 ..
Neuester Wissensbeitrag
CPU, RAM, Mainboards

Angetestet: PC Engines APU 3a2 im Rack-Gehäuse

(1)

Erfahrungsbericht von ashnod zum Thema CPU, RAM, Mainboards ...

Ähnliche Inhalte
Microsoft Office
gelöst CSV-Datei mit einem VBA Makro in Excel einlesen und leicht anpassen (5)

Frage von JoSiBa zum Thema Microsoft Office ...

Outlook & Mail
gelöst Ganztägier Outlooktermin per VBA aus Excel versenden (8)

Frage von Piotor04 zum Thema Outlook & Mail ...

Heiß diskutierte Inhalte
Switche und Hubs
Trunk für 2xCisco Switch. Wo liegt der Fehler? (13)

Frage von JayyyH zum Thema Switche und Hubs ...

DSL, VDSL
DSL-Signal bewerten (13)

Frage von SarekHL zum Thema DSL, VDSL ...

Backup
Clients als Server missbrauchen? (9)

Frage von 1410640014 zum Thema Backup ...

Windows Server
Mailserver auf Windows Server 2012 (9)

Frage von StefanT81 zum Thema Windows Server ...