Mail senden anstatt Outlook mit Lotus Notes

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Hallo Marco,
speziell für Lotus Notes nicht, aber unabhängig vom Mail Programm.
Auf Basis deiner dürftigen Auskünfte z. B. so.

' **********************************************************************
' Modul: Modul1  Typ: Allgemeines Modul
' **********************************************************************

Option Explicit

Private Const cstrSchema As String = "http://schemas.microsoft.com/cdo/configuration/"

'Anpassen!
Private Const cstrSMTPServer As String = "mail.provider.com"  'Fill in your SMTP-Server!
Private Const cstrUSERNAME As String = "Your Username" 'Fill in your Mailaccount Username
Private Const cstrPASSWORD As String = "Your Password" 'Fill in your Mailaccount Password
Private Const cstrADDRESS As String = "name@domain.com" 'Your Mail-Address

Sub sendMail_CDO()
'original code from http://www.rondebruin.nl/cdo.htm
Dim rCell As Range
Dim objMsg As Object, objConf As Object
Dim vntFields As Variant
Dim lngIndex As Long

On Error GoTo ErrExit

Set objMsg = CreateObject("CDO.Message")
Set objConf = CreateObject("CDO.Configuration")

objConf.Load -1    ' CDO Source Defaults
Set vntFields = objConf.Fields
With vntFields
  .Item(cstrSchema & "sendusing") = 2
  .Item(cstrSchema & "smtpserver") = cstrSMTPServer
  .Item(cstrSchema & "smtpserverport") = 25
  'When you also get the Authentication Required Error you can add this three lines.
  '    .Item(cstrSchema & "smtpauthenticate") = 1
  '    .Item(cstrSchema & "sendusername") = cstrUSERNAME
  '    .Item(cstrSchema & "sendpassword") = cstrPASSWORD
  .Update
End With

For Each rCell In Sheets("Liste").Range(tBRng)
  If IsDate(rCell.Offset(0, 6).Value) Then
    If rCell.Offset(0, 6) - Date <= Sheets("Liste").Range("A3").Value And Not (rCell. _
      Offset(0, 10).Value) Then     'Prüfe Meilenstein und Frist Mail
      With objMsg
        Set .Configuration = objConf
        .CC = rCell.Offset(0, 9)
        .BCC = ""
        .From = cstrADDRESS  'Absender
        .Subject = "Projekt: " & rCell.Offset(0, 3).Value      'E-Mail Betreff
        .TextBody = "Sehr geehrte(r) Frau/Herr .........."     'E-Mail Inhalt
        .Send
      End With
      rCell.Offset(0, 10).Value = True  'Beim senden der E-Mail in Spalte K, WAHR eintragen
    End If
  End If
Next

ErrExit:

If Err.Number <> 0 Then
  MsgBox "Fehler:" & vbTab & Err.Number & vbLf & vbLf & Err.Description & _
    vbLf & vbLf, vbExclamation, "Fehler"
End If

Set rCell = Nothing
Set objConf = Nothing
Set objMsg = Nothing
End Sub

Gruß Sepp

Beliebteste Forumthreads (12 Monate)

Mail senden anstatt Outlook mit Lotus Notes

2
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

301 Forumthreads zu ähnlichen Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

Mail senden anstatt Outlook mit Lotus Notes

2 Beiträge zum Forumthread Beiträge zu diesem Forumthread

301 Forumthreads zu ähnlichen Themen

VBA Beispiele zu verwandten Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

2
Beiträge zum Forumthread

Beiträge zu diesem Forumthread