senden mit Outlook express

Sub Blazer_senden() Dim blatt As Integer blatt = InputBox("Welches Blatt möchten Sie senden?" & Chr(13) & _ "Bitte die laufende Blattnummer eingeben") Sheets(blatt).Copy ActiveWorkbook.SendMail "evory@gmx.de", "Auftrag" Application.DisplayAlerts = False ActiveWindow.Close Application.DisplayAlerts = True MsgBox ("Ihr Auftragsblatt wurde erfolgreich in den Postausgang gelegt. Bitte nicht vergessen zu senden!") End Sub

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Hi Andreas,
beide nachstehenden Makros (ergoogelt) klappen bei mir.
Vielleicht kannst du ja was damit anfangen.
Gruß
Reinhard


Private Declare Function ShellExecute Lib "Shell32.dll" _
Alias "ShellExecuteA" (ByVal hwnd As Long, ByVal lpOperation As String, _
ByVal lpFile As String, ByVal lpParameters As String, ByVal lpDirectory As String, _
ByVal nShowCmd As Long) As Long
Sub Mail_Text_in_Body_2()
'Example for Outlook Express with API call
'In Excel 2002 I can use around 1800 characters
Dim msg As String, URL As String
Dim Recipient As String, Subj As String
Dim Recipientcc As String, Recipientbcc As String
Dim cell As Range
Recipient = "a@b.de"
Recipientcc = ""
Recipientbcc = ""
'You can use a cell value also like this
'Recipient = Sheets("mysheet").Range("A1").Value
Subj = "Testbodymail"
'Subj = Sheets("mysheet").Range("A2").Value
msg = "Dear customer" & vbNewLine & vbNewLine
For Each cell In Sheets("Tabelle1").Range("A1:A5")
msg = msg & vbNewLine & cell
Next cell
msg = WorksheetFunction.Substitute(msg, vbNewLine, "%0D%0A")
'If you have hard returns in one of your cells you also need this line (Tip from Keepitcool)
msg = WorksheetFunction.Substitute(msg, vbLf, "%0D%0A")
URL = "mailto:" & Recipient & "?cc=" & Recipientcc & "&bcc=" & Recipientbcc _
& "&subject=" & Subj & "&body=" & msg
ShellExecute 0&, vbNullString, URL, vbNullString, vbNullString, vbNormalFocus
Application.Wait (Now + TimeValue("0:00:4"))
SendKeys "%s"
End Sub
Sub Mail_Text_in_Body()
'Example for Outlook Express
'In Excel 2002 I can use around 600-700 characters
Dim msg As String, cell As Range
Dim Recipient As String, Subj As String, HLink As String
Dim Recipientcc As String, Recipientbcc As String
Recipient = "a@b.de"
Recipientcc = ""
Recipientbcc = ""
'You can use a cell value also like this
'Recipient = Sheets("mysheet").Range("A1").Value
Subj = "Testbodymail"
'Subj = Sheets("mysheet").Range("A2").Value
msg = "Dear customer" & vbNewLine & vbNewLine
For Each cell In Sheets("Tabelle1").Range("a1:a5")
msg = msg & vbNewLine & cell
Next cell
msg = WorksheetFunction.Substitute(msg, vbNewLine, "%0D%0A")
''If you have hard returns in one of your cells you also need this line (Tip from Keepitcool)
msg = WorksheetFunction.Substitute(msg, vbLf, "%0D%0A")
HLink = "mailto:" & Recipient & "?" & "cc=" & Recipientcc & "&" & "bcc=" & Recipientbcc & "&"
HLink = HLink & "subject=" & Subj & "&"
HLink = HLink & "body=" & msg
ActiveWorkbook.FollowHyperlink (HLink)
Application.Wait (Now + TimeValue("0:00:4"))
SendKeys "%s"
End Sub

Beliebteste Forumthreads (12 Monate)

3
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Links zu Excel-Dialogen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

senden mit Outlook express

3 Beiträge zum Forumthread Beiträge zu diesem Forumthread

VBA Beispiele zu verwandten Themen

Links zu Excel-Dialogen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

3
Beiträge zum Forumthread

Beiträge zu diesem Forumthread