Anzeige
Archiv - Navigation
880to884
Aktuelles Verzeichnis
Verzeichnis Index
Übersicht Verzeichnisse
Vorheriger Thread
Rückwärts Blättern
Nächster Thread
Vorwärts blättern
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
880to884
880to884
Aktuelles Verzeichnis
Verzeichnis Index
Verzeichnis Index
Übersicht Verzeichnisse
Inhaltsverzeichnis

Anhang an Email

Anhang an Email
01.07.2007 13:09:00
Herrmann
Hallo zusammen,
ich nutze den unten stehenden Code um eine Mail zu erzeugen. Die einzelnen Bestandteile der Mail werden aus der Tabelle22 ausgelesen. Eigentlich ist der Code fertig. Ich möchte allerdings, dass die aktive Mappe Anhang zu dieser Mail wird.
Kann mir da jemand helfen?
Vielen Dank im Voraus!
Gruß
Herrmann
Set MyOutApp = CreateObject("Outlook.Application")
Set MyMessage = MyOutApp.CreateItem(0)
With MyMessage
.To = Tabelle22.Range("B43") And Tabelle22.Range("B44")
.Subject = Tabelle22.Range("B45")
.body = Tabelle22.Range("B46") & Chr(13) & Tabelle22.Range("B47") & Chr(13) & Tabelle22.Range("B48") & Chr(13) & Tabelle22.Range("B49") & Chr(13) & Tabelle22.Range("B50")
.Display
'.Send 'Hier wird die Mail gesendet
End With
Set MyOutApp = Nothing
Set MyMessage = Nothing

1
Beitrag zum Forumthread
Beitrag zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: Anhang an Email
02.07.2007 09:39:55
AndrRo
Hallo Herrmann,
Dieses Makro ist von mir geschrieben und öffnet bei Aktivierung eine Email und die aktive Arbeitsmappe als Anhang rein. Sollte die Arbeitsdatei größer als 1 MB sein, wird diese dogar gezippt. Das Makro ist für die persönlichen Emails gedacht.
Ich hoffe, das ist es, was du suchtest.
gruss
Andreas

Sub Email_Versenden()
Dim objOutlook As Object
Dim objMail As Object
Dim AltName, DateiName As String
Dim sDatei As String
Dim sPfad As String
Set objOutlook = CreateObject("Outlook.Application")
Set objMail = objOutlook.createItem(0)
AltName = ActiveWorkbook.Name
If Right(AltName, 4) = ".xls" Then AltName = Left(AltName, Len(AltName) - 4)
DateiName = AltName & ".xls"
AltName = Replace(Environ("temp") & "\" & AltName & ".xls", " ", "")
ActiveWorkbook.SaveCopyAs AltName
' Zippen bei größer 1MB
If FileLen(AltName) >= 1048576 Then
zipname = Left(AltName, Len(AltName) - 4) & ".zip"
zip = "c:\Program Files\winzip\winzip32.exe -a "
Shell zip & zipname & " " & AltName
Application.Wait (Now + TimeValue("00:00:05"))
AltName = Left(AltName, Len(AltName) - 3) & "ZIP"
Kill Replace(Environ("temp") & "\" & DateiName, " ", "")
End If
' EMAIL
With objMail
.Subject = DateiName
.attachments.Add AltName
.display
End With
' Löschen Senddatei
Kill AltName
Set objOutlook = Nothing
Set objMail = Nothing
End Sub


Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige