Aus Ecxel mailen

[roger72]

Hi Folks

ich möchte gerne aus Excel mailen was mir bisher aber nur über Outlook gelang.

Ich arbeite in einem Netzwerk mit LN-Version 5.0.13.
Der Sever heisst "roger049/rf"
und die DB von der gesendet werden soll "mail\rfxc.nsf", Mailadresse xry@hotmail.com

Der Excel-Code der nun angepass werden muss lautet:

Option Explicit

Sub ExcelMX()
   Dim MyOutApp As Object, MyMessage As Object
   Dim Zelle As Range, src As Range
   
      Set src = Intersect(Selection, Columns(26))
   If src Is Nothing Then Exit Sub
   
  Set MyOutApp = CreateObject("Outlook.Application")   
   For Each Zelle In src
      Set MyMessage = MyOutApp.CreateItem(0)
      With MyMessage
         .To = Zelle 'E-Mail Adresse
         'Der Betreff in Spalte B
         .Subject = Range("AE2") '"Betreffzeil"
         'Der zu sendende Text in Spalte C
         'Maximal 1024 Zeichen
         'Der Text wird ohne Formatierung übernommen
         .Body = Range("AF2")
         'Hier wird die Mail angezeigt
         '.Display
         'Hier wird die Mail gleich in den Postausgang gelegt
         .Send
         ' und als gesendet markieren in Spalte D
         Zelle.Offset(0, 2).Value = Date
      End With
      'Objectvariablen leeren
      Set MyMessage = Nothing 'MyOutApp.CreateItem(0)
      'Sendepause einschalten
      'Outlook kann die Aufträge nicht schnell genug verarbeiten
      'Application.Wait (Now + TimeValue("0:00:05"))
   Next Zelle
   Set MyOutApp = Nothing 'CreateObject("Outlook.Application")
End Sub

Kann mir jemand die auf Lotus umschreiben?

[roger72]

Hallo,

ich habe da was gefunden. Allerdings klemmts nun beim "Send True". Hat jemand von euch eine Idee wie cih das Ding zum laufen kriege?

Hier der aktuelle Code:

Option Explicit
 
Sub Excel_Serial_Mail_neu()
   Dim MyOutApp As Object, MyMessage As Object
   Dim MyDB As Object, MyItem As Object
   Dim Zelle As Range, src As Range
   
   ' Schnittmenge aus allen selektierten Zellen und Spalte A
   Set src = Intersect(Selection, Columns(25))
   If src Is Nothing Then Exit Sub
   
   Set MyOutApp = CreateObject("Notes.NotesSession")
  Set MyDB = MyOutApp.GetDatabase("", "")
   Call MyDB.OpenMail

 
   'Start der Sendeschleife an alle in der Spalte A markierten Empfänger
   For Each Zelle In src
     
      Set MyMessage = MyDB.CreateDocument
      Set MyItem = MyMessage.CreateRichtextitem("Body")

      With MyMessage
         'Die Empfänger stehen in Spalte A ab Zeile 1
         .To = Zelle 'E-Mail Adresse
     
         .Subject = Range("AE2") '"Betreffzeil"
             
         .Body = Range("AF2")
         'Hier wird die Mail angezeigt
         '.Display
         'Hier wird die Mail gleich in den Postausgang gelegt
           .Send True
         
         ' und als gesendet markieren in Spalte D.//D.h. "0,2" ist die zweite Spalte nach der emaildadresse
         Zelle.Offset(0, 2).Value = Date
      End With
      'Objectvariablen leeren
      Set MyItem = Nothing
      Set MyMessage = Nothing 'MyOutApp.CreateItem(0)
      'Sendepause einschalten
     
      'Application.Wait (Now + TimeValue("0:00:05"))
   Next Zelle
   Set MyDB = Nothing
   Set MyOutApp = Nothing 'CreateObject("Outlook.Application")
End Sub

Gruss Roger

[roger72]

Liebe Notesprofis

ich habe mich nun noch ein Stück weiter gebracht. Gesendet wird nun aus Excel über Notes aber ohne Betreff und Text obschon in den angegebenen Zellen welcher vorhanden ist. Kennt sich da jemand aus?

Hier mein Code der mit Louts Mails versendet:

Option Explicit
 
Sub Excel_Serial_Mail()
   Dim MyOutApp As Object, MyMessage As Object
   Dim MyDB As Object, MyItem As Object
   Dim Zelle As Range, src As Range
   Dim lsa_SendTo(0) As String
   
   
   ' Schnittmenge aus allen selektierten Zellen und Spalte A
   Set src = Intersect(Selection, Columns(25))
   If src Is Nothing Then Exit Sub
   
   Set MyOutApp = CreateObject("Notes.NotesSession")
   Set MyDB = MyOutApp.GETDATABASE("", "")
   
   If MyDB.IsOpen = True Then
      'Already open for mail
   Else
      MyDB.OPENMAIL
   End If

   'Start der Sendeschleife an alle in der Spalte .... markierten Empfänger
   For Each Zelle In src
     
      Set MyMessage = MyDB.CreateDocument
      Set MyItem = MyMessage.CreateRichtextitem("Body")
     
      lsa_SendTo(0) = Zelle
     
      With MyMessage
         'Die Empfänger stehen in Spalte ........... ab Zeile 1
         .SendTo = lsa_SendTo '"Zelle" 'E-Mail Adresse
         'Der Betreff in Zelle AE2
         .Subject = Range("AE2") '"Betreffzeil"
         'Der zu sendende Text in Zelle AF2
         'Maximal 1024 Zeichen
         'Der Text wird ohne Formatierung übernommen
         .Body = Range("AF2")
         'Hier wird die Mail angezeigt
         '.Display
         'Hier wird die Mail gleich in den Postausgang gelegt
         .Form = "Memo"
         '.Send( True, "test")
         ' und als gesendet markieren in Spalte +2
         Zelle.Offset(0, 2).Value = Date
      End With
           
      MyMessage.PostedDate = Now() 'Gets the mail to appear in the sent items folder
      MyMessage.Send 0, lsa_SendTo
         
      'Objectvariablen leeren
      Set MyItem = Nothing
      Set MyMessage = Nothing 'MyOutApp.CreateItem(0)
      'Sendepause einschalten
      'Application.Wait (Now + TimeValue("0:00:05"))
   Next Zelle
   Set MyDB = Nothing
   Set MyOutApp = Nothing 'CreateObject("Outlook.Application")
End Sub

Gruss bobreto