Email Versand Thema 13784
12.03.2007 06:55:00
Ralf
Ich weiß, dieses Thema wurde schon mehrfach hier besprochen, ich habe aber im Archiv keine brauchbare Lösung für mein Problem gefunden.
Ich möchte aus einem Tabellenblatt heraus per Makro verschiedene Zellen in ein anderes Blatt kopieren und dieses eine Blatt per email (mit Outlook 2000) versenden. Das zu versendende Blatt ist in der Arbeitsmappe ausgeblendet. Das zu versendende Blatt soll als Dateinamen den Inhalt der Zellen A1 und A2 tragen.
Ich habe da mal mein bisheriges Werk mit angehängt.
Folgende Probleme:
1. Die verschickte Datei trägt den Namen Mappe2.xls
2. Die Datei wird nicht verschickt
Wer kann mir das Makro funktionsfähig anpassen?
Danke schon mal für Eure Hilfe.
Gruß
Ralf
Sub tippzettel_eMail()
Dim wsName As String
Dim blatt As Integer
wsName = ActiveSheet.Name
Application.DisplayAlerts = False
Sheets("eMail").Visible = True
Sheets(wsName).Range("D6:F15").Copy
Sheets("eMail").Range("B4").PasteSpecial Paste:=xlValues
Sheets(wsName).Range("K6:M15").Copy
Sheets("eMail").Range("G4").PasteSpecial Paste:=xlValues
Sheets(wsName).Range("D17:F26").Copy
Sheets("eMail").Range("B15").PasteSpecial Paste:=xlValues
Sheets(wsName).Range("K17:M26").Copy
Sheets("eMail").Range("G15").PasteSpecial Paste:=xlValues
Sheets(wsName).Range("D28:F37").Copy
Sheets("eMail").Range("B26").PasteSpecial Paste:=xlValues
Sheets(wsName).Range("A2:F2").Copy
Sheets("eMail").Range("A2").PasteSpecial Paste:=xlValues
Application.CutCopyMode = False
Sheets("eMail").Select
Range("A2").Select
Sheets(wsName).Select
Range("A1:F1").Select
Sheets("eMail").Copy
Dim Nachricht As Object, OutApp As Object
Set OutApp = CreateObject("Outlook.Application")
Dim AWS As String
AWS = ThisWorkbook.FullName
Set Nachricht = OutApp.CreateItem(0)
With Nachricht
.To = "email 1" & "; " & "email 2" & "; " & "email 3" & "; " & "email 4"
.Subject = "Tippzettel " & ActiveSheet.Range("A2")
.attachments.Add AWS
'Mail.Send
End With
'Outlook schliessen
OutApp.Quit
Set OutApp = Nothing
Set Nachricht = Nothing
End Sub