AW: senden mit Outlook express
Reinhard
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