Das Notes Forum
Domino 9 und frühere Versionen => Administration & Userprobleme => Thema gestartet von: roger72 am 28.12.05 - 17:50:21
-
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?
-
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
-
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