Live-Forum - Die aktuellen Beiträge
Datum
Titel
28.03.2024 21:12:36
28.03.2024 18:31:49
Anzeige
Archiv - Navigation
512to516
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
512to516
512to516
Aktuelles Verzeichnis
Verzeichnis Index
Verzeichnis Index
Übersicht Verzeichnisse
Inhaltsverzeichnis

Worksheet als attachment an mail senden

Worksheet als attachment an mail senden
05.11.2004 08:59:26
Hansueli
Habe mein Mail Problem soweit mit eurer Hilfe gelöst, Vielen Dank.
Nun zu meiner nächsten Hürde.
Anstelle von der im Macro eingebundenen email adresse soll das Macro die Emailadresse aus demselben workbook in zelle a1 nemen. Wie muss ich folgendes Macro abändern? Vielen Dank.
Hansueli

Sub test()
' test Macro
' Macro recorded 05.11.2004 by hus
ActiveWorkbook.SendMail "nospam@nospam.com", "Betreff"
End Sub

1
Beitrag zum Forumthread
Beitrag zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: Worksheet als attachment an mail senden
05.11.2004 10:13:31
Ralf
Hallo Hansueli,
hier mal ein Ansatz:

Sub Outlook_Mail_Every_Worksheet()
Dim OutApp As Outlook.Application
Dim OutMail As Outlook.MailItem
Dim strdate As String
Dim wb As Workbook
Dim ws As Worksheet
Application.ScreenUpdating = False
Set OutApp = CreateObject("Outlook.Application")
For Each ws In ThisWorkbook.Worksheets
If ws.Range("a1").Value Like "*@*" Then
strdate = Format(Now, "dd-mm-yy h-mm-ss")
ws.Copy
Set wb = ActiveWorkbook
With wb
.SaveAs "Sheet " & ws.Name & " of " _
& ThisWorkbook.Name & " " & strdate & ".xls"
Set OutMail = OutApp.CreateItem(olMailItem)
With OutMail
.To = ws.Range("a1").Value
.CC = ""
.BCC = ""
.Subject = "This is the Subject line"
.body = "Hi" & vbNewLine & vbNewLine & _
"This is line 1" & vbNewLine & _
"This is line 2" & vbNewLine & _
"This is line 3" & vbNewLine & _
"This is line 4"
.Attachments.Add wb.FullName
.Send
End With
.ChangeFileAccess xlReadOnly
Kill .FullName
.Close False
End With
Set OutMail = Nothing
End If
Next ws
Set OutApp = Nothing
Application.ScreenUpdating = True
End Sub

Aus der Internetseite von http://www.rondebruin.nl
Gruß
Ralf
Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige