Clever-Excel-Forum - VBA - Mail generieren

Seiten: 1 2

Hallo zusammen,

und hier kommt auch schon meine nächste Frage :D

Anbei findet Ihr meine Beispieldatei.

Ich möchte, dass bei Klick auf den Button eine Mail generiert (nicht geschickt) wird, die folgende Kriterien erfüllt.

> nur fällige Rechnungen, also YES in Spalte M, sollen in die Mail aufgenommen werden+
> die Mail soll dann wie folgt aufgebaut sein:

"Sehr geehrte Damen & Herren,

...

invoice number (hier sollen aber nur die Rechnungen gelistet sein, die in Spalte N den gleichen Empfänger haben!) + invoice amount + customer reference"

> Betreff der Mail soll alle Rechnungsnummern enthalten, die im Textkörper genannt sind + das aktuelle Datum
> Empfänger der Mail soll aus Spalte N übernommen werden + CC muss noch defniert werden

Kann mir jemand sagen, wie hierfür der VBA code aussehen muss?

Vielen Dank vorab

Viele Grüße
SteBen

Das gibt es doch zuhauf im Netz zu finden.

lmgtfy

Guten Morgen,

ich habe mir jetzt folgenden Code gebastelt.

Code:
Sub Schaltfläche1_Klicken()

 On Error GoTo ErrHandler

    ' SET Outlook APPLICATION OBJECT.

    Dim objOutlook As Object

    Set objOutlook = CreateObject("Outlook.Application")

    ' CREATE EMAIL OBJECT.

    Dim objEmail As Object

    Set objEmail = objOutlook.CreateItem(olMailItem)

    With objEmail

        .To = Range("$N:$N")

        .CC = ""

        .Subject = "Unpaid invoices - XX" & " - " & Date

        .Body = "To whom this may concern." & Chr(13) & Chr(13) & "Dear business partner," & Chr(13) & Chr(13) & "please be informed that the attached invoices have not been paid until today. Pls check the cases and advise until when these invoices will be paid!" & Chr(13) & "Thank you! & Best Regards" 

        .Display

        .Attachments.Add ("D:\XX\Desktop\XX - OP_template.xlsm")

        '.Send

    End With

    ' CLEAR.

    Set objEmail = Nothing:    Set objOutlook = Nothing

ErrHandler:

End Sub

Problem, sobald ich bei .To keine Mailadresse eintrage, läuft es nicht mehr.

Wie muss ich den Code ändern, damit der Empfänger immer aus der ersten befüllten Zeile in Spalte N, einer gefilterten Excel Datei gezogen wird?
Und wie bekomme ich die Email Signatur des jeweilgen Absenders in die Mail?

Danke Euch

noch ein Frage:

Ich will die Datei der Mail anhängen, das ist auch kein Problem, krieg ich hin. Nur ist die Datei 26MB groß & ich würde gerne vorm versenden eine Kopie speichern, die nur die aktuellen Daten gem. gesetzten Filtern enthält..

habe den Code mal aus einem anderen Projekt kopiert. Das speichern klappt ohne Probleme, nur wie muss der Code aussehen, damit eine .xlsx Datei gespeichert wird, die nur die gefilterten Daten enthält? Bekomme derzeit immer ein PDF...

Code:
'Selektion als xlsx exportieren, um attachement Größe klein zu halten

ThisWorkbook.Sheets("template").ExportAsFixedFormat Type=xlTypeXLSX, Filename:= _

  "P:\XXX", Quality:=xlQualityStandard, _

  IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=False

Vielen Dank für Euren Rat

Moin,

Zitat:Wie muss ich den Code ändern, damit der Empfänger immer aus der ersten befüllten Zeile in Spalte N, einer gefilterten Excel Datei gezogen wird?

Indem Du das .Offset(1,0) von .Range("N1") in Verbindung der Methode .SpecialCells(xlCellTypeVisible) verwendest.

Zitat:nur wie muss der Code aussehen, damit eine .xlsx Datei gespeichert wird, die nur die gefilterten Daten enthält? Bekomme derzeit immer ein PDF...

Erstelle ein Worksheet in einem neuen Workbkook und kopiere das Filtrat da rein oder beschäftige Dich einfach mit .SaveAs2.

Alternative könntest das Filtrat auch direkt in die Mail schreiben. Schau dir hierzu die Methode .RangeToHtml an.

Somit hast keine zweite Datei, aber eine Kopie der Mail im Ordner gesendete Objekte.

Hi Marco,

danke für die Hilfe.
Die Sache mit dem Mailempfänger habe ich hinbekommen - Danke schonmal!

Ich hänge gerade beim .RangetoHTML

Wie muss ich die Range im .HTMLBody anpassen, so dass nur alle Zeilen eingefügt werden, bei denen ein Wert in Spalte A steht?

Mein Code lautet so weit wie folgt: (hier wird nur der Wert aus A1 in die Mail kopiert... -.-

Code:
Sub Schaltfläche1_Klicken()

 On Error GoTo ErrHandler

    ' SET Outlook APPLICATION OBJECT.

    Dim objOutlook As Object

    Set objOutlook = CreateObject("Outlook.Application")

    ' CREATE EMAIL OBJECT.

    Debug.Print RangetoHTML(Range("A1").Offset(1, 0))

    Dim objEmail As Object

    Set objEmail = objOutlook.CreateItem(olMailItem)

    With objEmail

        .To = Range("N1").Offset(1, 0)

        .CC = ""

        .Subject = "Unpaid invoices - XXX" & " - " & Date

        .HTMLBody = "Dear business partner," & Chr(13) & Chr(13) & "please be informed that the below mentioned invoices have not been paid until today. Pls check the cases and advise until when the payment will be settled!" & Chr(13) & "Thank you! & Best Regards" & Chr(13) & "" & Chr(13) & Chr(13) & RangetoHTML(Range("A1").Offset(1, 0))

        .Display

    End With

    ' CLEAR.

    Set objEmail = Nothing:    Set objOutlook = Nothing

ErrHandler:

End Sub

Function RangetoHTML(rng As Range)

    Dim fso As Object

    Dim ts As Object

    Dim TempFile As String

    Dim TempWB As Workbook

    TempFile = Environ$("temp") & "/" & Format(Now, "dd-mm-yy h-mm-ss") & ".htm"

    ' Copy the range and create a workbook to receive the data.

    rng.Copy

    Set TempWB = Workbooks.Add(1)

    With TempWB.Sheets(1)

        .Cells(1).PasteSpecial Paste:=8

        .Cells(1).PasteSpecial xlPasteValues, , False, False

        .Cells(1).PasteSpecial xlPasteFormats, , False, False

        .Cells(1).Select

        Application.CutCopyMode = False

        On Error Resume Next

        .DrawingObjects.Visible = True

        .DrawingObjects.Delete

        On Error GoTo 0

    End With

    ' Publish the sheet to an .htm file.

    With TempWB.PublishObjects.Add( _

         SourceType:=xlSourceRange, _

         Filename:=TempFile, _

         Sheet:=TempWB.Sheets(1).Name, _

         Source:=TempWB.Sheets(1).UsedRange.Address, _

         HtmlType:=xlHtmlStatic)

        .Publish (True)

    End With

    ' Read all data from the .htm file into the RangetoHTML subroutine.

    Set fso = CreateObject("Scripting.FileSystemObject")

    Set ts = fso.GetFile(TempFile).OpenAsTextStream(1, -2)

    RangetoHTML = ts.ReadAll

    ts.Close

    RangetoHTML = Replace(RangetoHTML, "align=center x:publishsource=", _

                          "align=left x:publishsource=")

    ' Close TempWB.

    TempWB.Close savechanges:=False

    ' Delete the htm file.

    Kill TempFile

    Set ts = Nothing

    Set fso = Nothing

    Set TempWB = Nothing

End Function

Und noch eine Sache, wie bekomme ich die Mailsignatur des Kollegen in die Mail der das Makro auslöst?

Vielen Danke für die Hilfe!!

Eine Sache ist mir gerade noch aufgefallen.

Wenn ich das so schreibe

Code:
.To = Range("N1").Offset(1, 0)

dann nimmt er immer die Mailadresse, die in N2 steht, aber es sind ja unterschiedliche, je nachdem welcher Kunde es ist. Er muss sich also immer die 1. Zelle unter der Überschift der Spalte N als Empfänger ziehen....

Nue wie geht das?? Huh

Hab's auch noch so versucht, aber so tut sich leider nichts...

Code:
' CREATE EMAIL OBJECT.

    Debug.Print RangetoHTML(Range("A1", Range("A1").End(xlDown) & (Range("A1", Range("A1").End(xlToRight).Offset(1, 0)))))

Mase schrieb:Erstelle ein Worksheet in einem neuen Workbkook und kopiere das Filtrat da rein oder beschäftige Dich einfach mit .SaveAs2.

Anbei ein Code wo dir dir gefilterten Daten in Array schreibt, diese dann entsprechend im zu exportierenden Worksheet schreiben lassen.
(a bissl Lust an Leistung vorausgesetzt)

Code:
Sub FilteredRangeToArray()

    Dim sArr() As String

    Dim rngFiltrat As Range

    Dim arrRng() As Range

    Dim arrV() As Variant

    Dim i As Long

    Dim wks As Worksheet

    '

    Set wks = ThisWorkbook.Worksheets(1)

    '

    With Tabelle1

        '

        If Not .AutoFilterMode = True Then Exit Sub

        '

        Set rngFiltrat = .AutoFilter.Range.SpecialCells(xlCellTypeVisible)

        Let sArr = Split(rngFiltrat.AddressLocal, ";")

        ReDim arrRng(UBound(sArr))

        ReDim arrV(UBound(sArr))

        For i = 0 To UBound(sArr) Step 1

            Set arrRng(i) = Tabelle1.Range(sArr(i))

            Let arrV(i) = arrRng(i)

        Next i

    End With

    '

    Erase sArr()

    Erase rngFiltrat()

    Erase arrRng()

    Erase arrV()

End Sub

Zitat:' CREATE EMAIL OBJECT.

Debug.Print RangetoHTML(Range("A1", Range("A1").End(xlDown) & (Range("A1", Range("A1").End(xlToRight).Offset(1, 0)))))

Bspw so:

Code:
.Body = "Sehr geehrte ...." & RangeToHtml(Range("A1:A10"))

Hallo Marco,

danke für Deine Antwort, nur leider komme ich damit nicht weiter.
Bin VBA-Neuling & stückel mir die Sachen, die ich brauche son bisschen mit copy paste zurecht.

Deswegen wäre es super, wenn Du mir das ganze ein bisschen ausführlicher erklären könntest Blush

Besten Dank vorab

Hallo Marco, Forum,

noch eine Idee dazu? :)

Seiten: 1 2