AW: excel werte in e-mail übertragen
12.05.2015 16:34:18
Michael
Hallo Daniel!
Quick-and-dirty, sollte aber funktionieren. Der Codeteil zur Übernahme von Tabelleninhalten in ein Email ist im Original nicht von mir (hab ich selbst übernommen, Autor weiß ich nicht mehr). Achtung: Funktioniert nur mit installiertem Outlook als Email-Client.
In das Klassenmodul des betroffenen Tabellenblattes:
Private Sub Worksheet_Calculate()
Dim Check As Variant
Select Case Range("K46").Value
Case Is > 10000
Check = MsgBox("Sonderpreisanfrage senden?", vbOKCancel, "Preisanfrage")
If Check = vbOK Then Call Sonderpreisanfrage
Case Else
Exit Sub
End Select
End Sub
In ein allgemeines Modul:
Sub Sonderpreisanfrage()
Dim rngArtikel As Range
Dim rngZelle As Range
Dim lngZeile As Long
Dim lngSpalte As Long
Dim Zeile As String
Dim ZwSpeicher As String
Dim Text As String
Dim Betreff As String
Dim Nachricht As Object
Dim Outlook As Object
Set rngArtikel = Worksheets("Tabelle1").Range("B24:C45")
Set Outlook = CreateObject("Outlook.Application")
Set Nachricht = Outlook.CreateItem(0)
For Each rngZelle In rngArtikel.Areas
For lngZeile = 1 To rngZelle.Rows.Count
For lngSpalte = 1 To rngZelle.Columns.Count
Zeile = Zeile & " " & rngZelle.Cells(lngZeile, lngSpalte)
Next
ZwSpeicher = ZwSpeicher & vbCrLf & Zeile
Zeile = ""
Next
Text = Text & vbCrLf & ZwSpeicher
ZwSpeicher = ""
Next
Betreff = Range("B17").Value & " " & Range("B19").Value
With Nachricht
.To = "max@mustermann.com"
.Subject = Betreff
.Body = "Sehr geehrter Herr .......!" & vbCrLf & vbCrLf _
& "Bitte um Sonderpreis für: " & Text & vbCrLf & vbCrLf & "Vielen Dank!"
.Display
End With
Set Outlook = Nothing
Set Nachricht = Nothing
End Sub
LG
Michael