Microsoft Excel

Herbers Excel/VBA-Archiv

Informationen und Beispiele zum Thema MsgBox
BildScreenshot zu MsgBox MsgBox-Seite mit Beispielarbeitsmappe aufrufen

Automatisierter Email Versand xls vba

Betrifft: Automatisierter Email Versand xls vba von: Christian
Geschrieben am: 09.08.2008 11:00:07

Hallo an alle Experten,

ich habe ein größeres Problem bezüglich des Versands von Woksheets als email Anhang und bräuchte dringend Hilfe.

Die Situation ist folgende:

Ich hab in verschiedenen Verzeichnissen(Ordnern) Excel WB (=Berichte/Reports) erzeugt, die jeweils nur aus einem Sheet bestehen welches den gleichen Namen trägt wie das WB selbst!

Es gibt vier verschieden Ordner in denen die Dateien abgelegt werden.

Also in Y:\Reports\FR Reports liegt z.B. ein MAS_FR.xls, dass ein Sheet namens MAS_FR beinhaltet.

Nun habe ich eine Tabelle in einem neuen Workbook erstellt die regeln soll, welcher Benutzer welche Workbooks - bzw. eigentlich welche Worksheets, als email Anhang empfangen soll.

Die Tabelle besteht aus der Spalte A in der die Namen der Sheets (z.B. MAS_FR) gelistet sind und aus zwei Zeilen.

Zeile 1 beinhaltet den Namen des Empfängers / Zeile 2 die Email Adresse des Empfängers.

Wenn ein Empfänger den Report erhalten soll, steht in der entsprechenden Zelle die aus Spaltenangabe A (für den Bericht) und Zeileangabe 2 (Welche Email) besteht eine 1 - ansonsten bleibt die Zelle leer;

..also wenn Zellwert = 1 dann erhält er den Bericht , Wenn Zellwert = leer dann nicht!

Klasse wäre es jetzt allerdings nicht alle Berichte als einzelne .xls Dateien anhängen zu können - sondern vor dem Versand ein WB zu generieren dass alle Berichte (für den jeweiligen Empfänger) in jeweils ein WB mit seinem Namen (Laut Zeile1) kopiert und danach dieses konsolidierte WB als Anhang an die EmpfängerAdresse sendet....

Das ganze sollte geplanterweise als Schleife ablaufen nach dem Motto, gehe Spalte B durch....(Start Zeile 3 bis 400) - für jede Zelle in B in der eine "1" steht gehe zum Sheet in gleichnamiger Datei (Name steht in Spalte A der gleichen Zeile) und kopiere dieses Sheet in ein neues WB mit dem Namen der in B1 (=Empfängernamen) steht und sende dieses WB per Mail an die Email-Adresse in B2....

Umfang ca. 300 Sheets in Spalte A (entspricht 300 .xls _Dateien und ca. 30 Empfänger....

Weiss es nicht genau - aber am Schlauesten wäre es wahrscheinlich zunächst innerhalb der Schleife ein neues WB generieren zu lassen und dann die nachfolgenden Schritte abzuarbeiten??!!

Das übersteigt leider meine VBA Kenntnisse bei weitem obgleich ich sicher bin, dass es für einen Experten ohne größere Probleme machbar sein solllte?!

Vielen Dank schon mal vorab für alle Tipps und Hilfen?! Ihr würdet mir sehr helfen meine Arbeit zu vereinfachen! Natürlich ist es dringend..;-)

Gruß Christian

  

Betrifft: AW: Automatisierter Email Versand xls vba von: Matthias G
Geschrieben am: 09.08.2008 14:11:08

Hallo Christian,

ich habe den Aufbau der Datei nicht verstanden.

In Spalte A sind die Namen der Sheets bzw. Workbooks, ok.
Und wo sind die Verzeichnisse (es sind ja vier)?
Und was sind das für "zwei Zeilen"? Eine Zeile beinhaltet in Excel ja alle Spalten incl. Spalte A...

Vielleicht lädst du mal eine Musterdatei hoch.

Gruß Matthias


  

Betrifft: AW: Automatisierter Email Versand xls vba von: Christian
Geschrieben am: 09.08.2008 17:43:17

Hi Matthias,

vorab schonmal Danke, dass du Dir dasGanze mal anschauen willst.

Unter nachfolgendem Link hab ich das Sheet inklusive einer kurzen Erläuterung mal hochgeladen.

https://www.herber.de/bbs/user/54471.xls

Denke dann wird einiges klarer?! Wäre extrem dankbar für Hilfe jeglicher Art?!

Gruß Christian


  

Betrifft: AW: Automatisierter Email Versand xls vba von: Matthias G
Geschrieben am: 10.08.2008 09:22:23

Hallo Christian,

hier schonmal der Code, der in einem gewünschten Verzeichnis die personenbezogenen Mappen anlegt.


Option Explicit

Declare Function MakeSureDirectoryPathExists Lib "imagehlp.dll" (ByVal Pfad As String) As Long

Public Const wDir = "C:\Dokumente und Einstellungen\FR_Reports\" '\ am Ende nicht vergessen!
Public Const Blattname = "Tabelle1" ' Name des Blattes dieser Mappe mit den Daten
Public Const eZ = 3  'erste Zeile mit Daten (3: d.h. 2 Zeilen Überschrift)
Public Const iName = 1
Public Const iEmail = 2

Sub Start()
Dim lZ As Long 'letzte Zeile mit Daten
Dim ASp As Integer 'Anzahl der Spalten (2 bis ASp) mit Namen
Dim ShData As Worksheet
Dim strName As String
Dim strEmail As String
Dim sp As Integer, ze As Integer, anzB As Integer

Dim wb1 As Workbook, wbP As Workbook
Dim strTemp As String
Dim MailDir As String

' Verzeichnis, in dem die personenbezogenen Mappen gespeichert werden
' (\ am Ende nicht vergessen!)
MailDir = ThisWorkbook.Path & "\mails\"
' Verzeichnis bei Bedarf erstellen:
MakeSureDirectoryPathExists MailDir

Application.ScreenUpdating = False

Set ShData = ThisWorkbook.Sheets(Blattname)
With ShData
    'letzte Zeile ermitteln
    lZ = .Cells(.Rows.Count, 1).End(xlUp).Row
    If lZ = 1 Then
        If .Cells(.Rows.Count, 1) <> "" Then lZ = .Rows.Count
        If .Cells(1, 1) = "" Then lZ = 0
    End If
    If lZ < eZ Then MsgBox "Keine Daten!": Exit Sub
    
    sp = 2
    'Do-Schleife: Spalte 2 bis Ende nach rechts
    Do
        strName = .Cells(iName, sp)
        strEmail = .Cells(iEmail, sp)
        If strName = "" Then Exit Do
        Application.StatusBar = "bearbeite " & strName

        'Name der personenbezogenen Mappe
        strTemp = MailDir & strName & ".xls"
        
        'For-Schleife: Zeile [eZ] bis [lZ]
        anzB = 0
        For ze = eZ To lZ
        
            'Zelle nicht leer (also "1")?
            If .Cells(ze, sp) <> "" Then
                anzB = anzB + 1
                Set wb1 = Workbooks.Open(wDir & .Cells(ze, 1) & ".xls")
                If anzB = 1 Then
                    Set wbP = wb1
                Else
                    wb1.Sheets(1).Copy After:=wbP.Sheets(wbP.Sheets.Count)
                    wb1.Close False
                End If
            End If
                        
        Next ze
        
        If anzB > 0 Then
            'personenbezogene Mappe speichern
            Application.DisplayAlerts = False
            wbP.SaveAs Filename:=strTemp
            Application.DisplayAlerts = True
            wbP.Close
        Else
            'evtl. alte, vorhandene personenbezogene Mappe löschen, wenn keine
            'Blätter zum Versenden angegeben wurden
            If Dir(strTemp) <> "" Then Kill strTemp
        End If
        
        sp = sp + 1
        If sp > .Columns.Count Then Exit Do
    Loop
End With
Application.ScreenUpdating = True
Application.StatusBar = False
End Sub



Der Rest der Aufgabe, die Mappen zu versenden, ist noch offen.
Beim Mailversand mit Outlook kenne ich mich nicht aus, aber soweit klappt es schonmal - zumindest bei mir.

Gruß Matthias


  

Betrifft: AW: Automatisierter Email Versand xls vba von: Christian
Geschrieben am: 11.08.2008 14:47:22

So Matthias,

ich konnte das Ganze erst heute wirklich testen und muss sagen.....

Absolut spitzenmäßig! Respekt. Das Makro tut genau was es soll.
Der email Versand wird mit einem kleinen Zweizeiler am Ende der Schleife abgefrühstückt!

Vielen Dank für deine schnelle und kompetente Hilfe.

You made my day

Gruß Christian


  

Betrifft: AW: Automatisierter Email Versand xls vba von: Matthias G
Geschrieben am: 12.08.2008 10:21:12

Hallo Christian,

Danke für die Rückmeldung.

Freut mich, dass es funktioniert.

Gruß Matthias


 

Beiträge aus den Excel-Beispielen zum Thema "Automatisierter Email Versand xls vba"