Thema: Mail aus Access heraus


Seite durchsuchen:
Home


zurück zur Übersicht

Diskussionsgruppe: Datenbanken

Hallo zusammen,

wow, neues Design von Supportnet, sieht klasse aus ;-)

Nun zu meinem Problem:

Ich möchte gerne Email`s aus Access heraus generieren, Email Proggi ist Lotus Notes.

Dazu habe ich ein Form erstellt mit Empfänger, Absender,Betreff und Text

Die Daten für Empfänger, Absender,Betreff hol ich mir aus einem Formular was der User vorher bearbeitet hat heraus, das klappt.

Jetzt soll aber noch der Inhalt einer Abfrage und eventuel ein paar Zeilen eigener Kommentar in die Mail.

Hat da jemand ne Idee ?

Gruß Ralf

 Von: RalfH Datum: 18.04.2007, 10:37

alle Antworten zu dieser Frage


Antwort 1 von Teddy7 vom 18.04.2007, 11:47
Hallo Ralf !

Nicht auf meinem Mist gewachsen, aber man mutiert ja zum Jäger und Sammler:
//////////////
Sub SendNotesMail(ByVal MailTo As String, ByVal MailText As String, ByVal MailAnhang As String, _
ByVal MailAbsender As String, ByVal MailBetreff As String, _
Optional MailSenden = True)
'
' Versenden einer E-Mail via Lotus Notes.
'
' IN: MailTo E-Mail Adresse des Empfängers
' MailText Text der Nachricht
' MailAnhang Dateianhang (Dateiname mit Pfad)
' MailAbsender Name des Absenders (wird an den Text angeängt)
' MailBetreff Betreffzeile der E-Mail
' MailSenden True wenn Nachricht versendet werden soll,
' False wenn Nachricht als Entwurf gespeichert werden soll
'
Dim rtitem As Object
Dim EmbeddedObject As Object
Dim SessionNotes As Object, NotesDB As Object, NotesDoc As Object
Dim EmpfListe() As String
Dim EmpfCnt As Integer
Dim Pos1 As Long
'
' wenn die Betreffzeile leer ist, dann wird eine erzeugt
'
If Trim$(MailBetreff) = "" Then
MailBetreff = "Mail vom " & Date & " " & Time
End If
'
' Eigene Fehlerbehandlung
'
On Error GoTo Err_Mail_Click
'
' An die laufende Lotus Notes Session anhängen
'
Set SessionNotes = CreateObject("Notes.NOTESSESSION")
'
' Notes Datenbank-Objekt erstellen und initialisieren
'
Set NotesDB = SessionNotes.GetDatabase("", "")
NotesDB.OPENMAIL
If NotesDB.ISOPEN = False Then
MsgBox "Bitte melden Sie sich zunächst vollständig in Notes an!", vbInformation + vbOKOnly
Exit Sub
End If
'
' Empfängerliste erstellen
'
' EmpfCnt = 0
' Pos1 = InStr(MailTo, ";")
' While Pos1 > 0
' ReDim Preserv EmpfListe(EmpfCnt)
' EmpfListe(EmpfCnt) = Left(MailTo, Pos1 - 1)
' MailTo = Right(MailTo, Len(MailTo) - Pos1)
' Pos1 = InStr(MailTo, ";")
' EmpfCnt = EmpfCnt + 1
' Wend
' ReDim Preserv EmpfListe(EmpfCnt)
' EmpfListe(EmpfCnt) = MailTo
'
' Neues Notes-Dokument anlegen (Mail)
'
Set NotesDoc = NotesDB.CreateDocument
With NotesDoc
.Form = "Memo"
.Subject = MailBetreff
.sendto = "alfred.quack@beispiel-provider.de"
'.copyto = ' Kopie an
'.blindcopyto= Blindkopie an
.Body = MailText & vbCrLf & MailAbsender
'.DefaultMailSaveOption = 0
'.MailSaveOption = 0
.DeliveryReport = "B"
.Importance = "1"
'.logo = "Scania"
.SAVEMESSAGEONSEND = True ' bei True wird ein Exemplar in Notes in Gesendet gestellt
.ReturnReceipt = "1"
.Sign = "1"
'.encrypt ="0"
'.Principal = session.UserName
'.viewicon ="74"
'.from = session.UserName
'.SaveOptions = 0
'.SecureMail = ""
'.SenderTag = "F"

'''''''''''''' Dateianhang'''''''''''''''''
Dim xy
Dim mailanhang2, s As Variant

Const delim = ";"
Const embed_ATT = 1454

s = Split(MailAnhang, delim)

For xy = LBound(s) To UBound(s)
mailanhang2 = s(xy)



Set rtitem = .CreateRichTextItem(mailanhang2)
Set EmbeddedObject = rtitem.EmbedObject(embed_ATT, "", mailanhang2, mailanhang2)



Next xy
''''''''''''''''''''''''''''''''''''''''''

If MailSenden Then
.Send False
Else
.Save
End If
End With

Set SessionNotes = Nothing
Set NotesDB = Nothing
Set NotesDoc = Nothing
Set rtitem = Nothing
Set EmbeddedObject = Nothing

Exit_Mail_Click:
Exit Sub
Err_Mail_Click:
MsgBox Err.Description
Resume Exit_Mail_Click
End Sub




Und das ist ein Beispiel zum Aufruf mit vorheriger Auswahl der Attachments. Man muss natürlich das ganze so anpassen wie es einem selbst gefällt:

Zitat:Sub mailtest()
Dim Empf, MText
Dim Anlage, MAbsender, MBetreff

Dim dlgfilepicker As FileDialog, selItem As Variant

Set dlgfilepicker = Application.FileDialog(msoFileDialogOpen)

With dlgfilepicker
.AllowMultiSelect = True
.Show
For Each selItem In .SelectedItems

Anlage = Anlage & CStr(selItem) & ";"
Next selItem

End With

If Right(Anlage, 1) = ";" Then
Anlage = Left(Anlage, Len(Anlage) - 1)
End If

MAbsender = "alfred.quack@beispiel-provider.de"
MBetreff = InputBox("Geben Sie hier Ihren Betreff ein: ", "Betreff", "<Kein Betreff>")

SendNotesMail Empf, MText, Anlage, MAbsender, MBetreff, True

End Sub
////////////////////

Vielleicht hilfts ja.
Gruß
Teddy

Antwort 2 von RalfH vom 18.04.2007, 12:07
Danke Teddy7,

Ich habe das hier und es Funktionakelt!

Private Sub Befehl9_Click()
Dim Subject As String, attachment As String, bodytext As String, saveit As Boolean
Dim ToAdressen(10) As String



Dim Maildb As Object 'Die Datenbank
Dim UserName As String 'Der Benutzername
Dim MailDbName As String 'Der Datenbankname
Dim MailDoc As Object 'Das Maildokument selbst
Dim AttachME As Object 'Der Anhang (Richtext)
Dim Session As Object 'Die Notes Session
Dim EmbedObj As Object 'Ein eingebettetes Objekt (Anhang)
Dim Recip(2) As Variant
Dim LinkME As Object
Dim testlink As String

Subject = Text1.Value
bodytext = Text12.Value
ToAdressen(1) = Text1.Value
' attachment = AppPfad & "\Links.xls"

'Die Session starten
Set Session = CreateObject("Notes.NotesSession")

On Error GoTo Fehler:
'Den Benutzernamen auslesen und den Dateinamen
'der MailDB errechnen
'Dies wird nicht überall benötigt. Auf manchen
'Systemen kann auch ein leerer String übergeben werden
UserName = Session.UserName
MailDbName = Left$(UserName, 1) & Right$(UserName, (Len(UserName) - InStr(1, UserName, " "))) & ".nsf"

'Datenbank öffnen
Set Maildb = Session.GetDatabase("", MailDbName)
If Maildb.IsOpen = True Then
Else
Maildb.OPENMAIL
End If

'Ein neues Maildokument erstellen
Set MailDoc = Maildb.CreateDocument
MailDoc.Form = "Memo"
MailDoc.sendto = Me!Text1
MailDoc.Subject = Subject
MailDoc.body = bodytext
MailDoc.SaveMessageOnSend = True

'Eingebettete Objekte und Anhänge hinzufügen
If attachment <> "" Then
Set AttachME = MailDoc.CreateRichTextItem("Attachment")
Set EmbedObj = AttachME.EmbedObject(1454, "", attachment, "Attachment")
'MailDoc.CREATERICHTEXTITEM ("Attachment")
End If

'Senden
MailDoc.PostedDate = Now()

If ToAdressen(1) = "" Then
MsgBox "Please enter recipients!"
GoTo Fehler2
Else
MailDoc.Send 0, ToAdressen
MsgBox "Message transmitted"
GoTo Fehler2
End If

'Aufräumen
Set Maildb = Nothing
Set MailDoc = Nothing
Set AttachME = Nothing
Set Session = Nothing
Set EmbedObj = Nothing

Fehler:
MsgBox "Please open your Lotus Notes client!"
Exit Sub

Fehler2:
Exit Sub
End Sub
Einen richtig schönen Tag wünsche ich dann noch.
Gruß Ralf

Antworten der Gruppe: Datenbanken
www.supportnet.de



Office 365 stellt vertraute Microsoft Office-Tools für die Zusammenarbeit und Produktivität über die Cloud bereit. So können alle ganz einfach von nahezu überall zusammenarbeiten und auf E-Mails, Webkonferenzen, Dokumente und Kalender zugreifen.