Re: Werte aus TAbelle übernehmen und versenden
17.10.2002 20:39:42
Mike E.
Hallo,diesen Code musst du im VBA-Editor deiner "Tabelle1" unter der
Worksheets-Eigenshaft "BeforeRightClick" zuweisen.
Schau dir die Bemerkungen im Code an, dort steht, wie ich die Tabelle1 angeordnet habe (so wie ich das aus deiner Frage entnehmen konnte). Sieht es bei dir anders aus, musst du entweder den Code oder deine Tabelle anpassen.
Gruß Mike
Dim Absender As String
Dim Empfänger As String
Dim ccEmpfänger As String
Dim bccEmpfänger As String
Dim Betreff As String
Dim Anrede As String
Dim Pfad As String
Dim Blattname As String
Absender = ""
Rem Das aktiveBlatt muss in deinem Beispiel "Tabelle1" sein.
Rem Die E-Mail-Adresse steht in Spalte A, Die Anrede in Spalte B,
Rem der Betreff in Spalte C, und der Name in Spalte E;
Rem zum Versenden musst du auf die E-Mail-Adresse mit der rechten Maustaste klicken.
Empfänger = ActiveCell
ccEmpfänger = ""
bccEmpfänger = ""
Betreff = ActiveCell(1, 3)
Anrede = ActiveCell(1, 2) & " " & ActiveCell(1, 5) & ","
Rem gibt dien Pfad deiner Ursprungstabelle zurück
Pfad = Left(ThisWorkbook.FullName, Len(ThisWorkbook.FullName) - Len(Dir(ThisWorkbook.FullName)))
Rem Gibt dem zu versendenden Tabellenblatt einen neuen Namen
Blattname = "ForYou"
Rem Hier wird der Inhalt aus dem zu versendenen Blatt in eine neue Arbeits-
Rem mappe eingefügt.
Sheets("Tabelle2").Select
ActiveSheet.Cells.Select
Selection.Copy
Workbooks.Add
Sheets("Tabelle1").Select
ActiveSheet.Cells.Select
Selection.PasteSpecial Paste:=xlFormats, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=False
Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=False
Application.CutCopyMode = False
Rem Die neue Mappe wird unter dem Pfad gespeichert,
Rem aus dem die Ursprungsdatei entstammt. Am Ende des Codes wird sie wieder gelöscht.
ActiveWorkbook.SaveAs Pfad & Blattname & ".xls"
ActiveWorkbook.Close
Rem Ab hier wird die Outlook-Applikation aufgerufen
Dim olApp As Outlook.Application
Dim objNachrich As MailItem
Set olApp = New Outlook.Application
Set objNachrich = olApp.CreateItem(0)
Set Mail = objNachrich
Mail.SentOnBehalfOfName = Absender
Mail.To = Empfänger
Mail.BCC = bccEmpfänger
Mail.CC = ccEmpfänger
Mail.Body = Anrede & Chr(10) & Chr(10) & "Gruß" & Chr(10) & "MeinName" & Chr(10) & Chr(10)
Mail.Subject = Betreff
Mail.Attachments.Add Pfad & Blattname & ".xls"
Mail.Importance = 2
Mail.Display
Kill Pfad & Blattname & ".xls"