Hallo Glombi,
hier die Codierung aus dem Formular frm_EMail
ist vermutlich kein VisualBasic-Code sondern MS-Access pur....
============
Option Compare Database
Option Explicit
Private Sub AN_holen_Click()
On Error GoTo Err_AN_holen_Click
Dim DocName As String
Me![Tmp] = "An"
DocName = "frm_Email_Auswahl"
DoCmd.OpenForm DocName, , , , , , Me.Name
Exit_AN_holen_Click:
Exit Sub
Err_AN_holen_Click:
MsgBox Err.Description
Resume Exit_AN_holen_Click
End Sub
Private Sub BCC_holen_Click()
On Error GoTo Err_BCC_holen_Click
Dim DocName As String
Me![Tmp] = "Bcc"
DocName = "frm_Email_Auswahl"
DoCmd.OpenForm DocName, , , , , , Me.Name
Exit_BCC_holen_Click:
Exit Sub
Err_BCC_holen_Click:
MsgBox Err.Description
Resume Exit_BCC_holen_Click
End Sub
Private Sub CC_holen_Click()
On Error GoTo Err_CC_holen_Click
Dim DocName As String
Me![Tmp] = "Cc"
DocName = "frm_Email_Auswahl"
DoCmd.OpenForm DocName, , , , , , Me.Name
Exit_CC_holen_Click:
Exit Sub
Err_CC_holen_Click:
MsgBox Err.Description
Resume Exit_CC_holen_Click
End Sub
Private Sub Form_Load()
On Error GoTo Err_Form_Load
Me![Objektart] = Null
Me![Sende_KZ] = DLookup("[Sende_KZ]", "tbl_AP_Mail_Manager_Einstellungen", "[ID]=1")
Exit_Form_Load:
Exit Sub
Err_Form_Load:
MsgBox Err.Description
Resume Exit_Form_Load
End Sub
Private Sub Objekt_AfterUpdate()
On Error GoTo Err_Objekt_AfterUpdate
If (IsNull(Me![Format]) Or (Me![Format] = "")) Then
Me![Format] = "HTML"
End If
If (IsNull(Me![Objekt])) Or (Me![Objekt] = "") Then
Me![Format].Visible = False
Else
Me![Format].Visible = True
If Me![Objektart] = "Modul" Then
Me![Format].Enabled = False
End If
End If
Exit_Objekt_AfterUpdate:
Exit Sub
Err_Objekt_AfterUpdate:
MsgBox Err.Description
Resume Exit_Objekt_AfterUpdate
End Sub
Private Sub Objektart_AfterUpdate()
On Error GoTo Err_Objektart_AfterUpdate
Me![Objekt] = ""
If (IsNull(Me![Format]) Or (Me![Format] = "")) Then
Me![Format] = "HTML"
End If
Select Case Me![Objektart]
Case "Tabelle"
Me![Objekt].Visible = True
Me![Objekt].RowSource = "SELECT MSysObjects.Name FROM MSysObjects WHERE (((MSysObjects.Type) = 1) And ((MSysObjects.Flags) = 0) And ((LCase(Left([Name], 4))) <> 'usys')) Or (((MSysObjects.ForeignName) Is Not Null)) ORDER BY MSysObjects.Name;"
Case "Abfrage"
Me![Objekt].Visible = True
Me![Objekt].RowSource = "SELECT MSysObjects.Name FROM MSysObjects WHERE (((MSysObjects.Type) = 5) And ((MSysObjects.Flags) <> 3)) ORDER BY MSysObjects.Name;"
Case "Formular"
Me![Objekt].Visible = True
Me![Objekt].RowSource = "SELECT MSysObjects.Name FROM MSysObjects WHERE (((MSysObjects.Type) = -32768) And ((MSysObjects.Flags) = 0)) ORDER BY MSysObjects.Name;"
Case "Bericht"
Me![Objekt].Visible = True
Me![Objekt].RowSource = "SELECT MSysObjects.Name FROM MSysObjects WHERE (((MSysObjects.Type) = -32764) And ((MSysObjects.Flags) = 0)) ORDER BY MSysObjects.Name;"
Case "Modul"
Me![Format] = "TXT"
Me![Objekt].Visible = True
Me![Objekt].RowSource = "SELECT MSysObjects.Name FROM MSysObjects WHERE (((MSysObjects.Type) = -32761) And ((MSysObjects.Flags) = 0)) Or (((MSysObjects.Type) = -32761) And ((MSysObjects.Flags) = 256)) ORDER BY MSysObjects.Name;"
Case Else
Me![Objekt] = Null
Me![Objekt].Visible = False
End Select
Objekt_AfterUpdate
Exit_Objektart_AfterUpdate:
Exit Sub
Err_Objektart_AfterUpdate:
MsgBox Err.Description
Resume Exit_Objektart_AfterUpdate
End Sub
Private Sub Schließen_Click()
On Error GoTo Err_Schließen_Click
Felder_löschen
DoCmd.Close acForm, Me.Name
Exit_Schließen_Click:
Exit Sub
Err_Schließen_Click:
MsgBox Err.Description
Resume Exit_Schließen_Click
End Sub
Private Sub Senden_Click()
On Error GoTo Err_Senden_Click
Dim H_Sende_KZ
If (((IsNull(Me![an])) Or (Me![an] = "")) And ((IsNull(Me![cc])) Or (Me![cc] = "")) And ((IsNull(Me![bcc])) Or (Me![bcc] = ""))) Then
MsgBox "In den Feldern " & Chr(34) & "An" & Chr(34) & ", " & Chr(34) & "Cc" & Chr(34) & " oder " & Chr(34) & "Bcc" & Chr(34) & " muss Mindestens eine Empfängeradresse stehen", vbOKOnly + vbExclamation, AppName
DoCmd.GoToControl "an"
Exit Sub
End If
If ((IsNull(Me![Betreff])) Or (Me![Betreff] = "")) Then
If vbNo = MsgBox("Sie haben keinen Betreff angegeben." & vbCrLf & "Möchten Sie das Mail trotzdem versenden?", vbYesNo + vbQuestion, AppName) Then
DoCmd.GoToControl "Betreff"
Exit Sub
End If
End If
If ((IsNull(Me![Mailinhalt])) Or (Me![Mailinhalt] = "")) Then
If vbNo = MsgBox("Sie haben keinen Text für das Mail eingegeben." & vbCrLf & "Möchten Sie das Mail trotzdem versenden?", vbYesNo + vbQuestion, AppName) Then
DoCmd.GoToControl "Mailinhalt"
Exit Sub
End If
End If
If IsNull(Me![an]) Then Me![an] = ""
If IsNull(Me![cc]) Then Me![cc] = ""
If IsNull(Me![bcc]) Then Me![bcc] = ""
If IsNull(Me![Mailinhalt]) Then Me![Mailinhalt] = ""
If IsNull(Me![Betreff]) Then Me![Betreff] = ""
If IsNull(Me![Objektart]) Or (Me![Objektart] = "") Then
DoCmd.Hourglass True
DoCmd.SendObject , "", "", Me![an], Me![cc], Me![bcc], Me![Betreff], Me![Mailinhalt], Me![Sende_KZ]
DoCmd.Hourglass False
Else
If ((IsNull(Me![Objekt])) Or (Me![Objekt] = "")) Then
MsgBox "Sie haben für das Versenden kein Objekt angegeben." & vbCrLf & "Bitte wählen Sie ein Objekt aus!", vbOKOnly + vbCritical, AppName
DoCmd.GoToControl "Objekt"
Exit Sub
End If
If ((IsNull(Me![Format])) Or (Me![Format] = "")) Then
MsgBox "Sie haben für das Versenden kein Format angegeben." & vbCrLf & "Bitte wählen Sie ein Format aus!", vbOKOnly + vbCritical, AppName
DoCmd.GoToControl "Format"
Exit Sub
End If
If (Me![Objektart] = "acSendModule") Then
Me![Format] = "TXT"
End If
DoCmd.Hourglass True
Senden_mit_Anhang
DoCmd.Hourglass False
End If
If DLookup("[Meldung_nach_Senden]", "tbl_AP_Mail_Manager_Einstellungen", "[ID]=1") Then
MsgBox "Ihr Mail wurde dem Standard-Mailprogramm übergeben.", vbOKOnly + vbInformation, AppName
End If
Felder_löschen
If DLookup("[Schliessen_nach_Senden]", "tbl_AP_Mail_Manager_Einstellungen", "[ID]=1") Then
DoCmd.Close acForm, Me.Name
End If
Exit_Senden_Click:
Exit Sub
Err_Senden_Click:
DoCmd.Hourglass False
MsgBox Err.Description
Resume Exit_Senden_Click
End Sub
Private Sub Senden_mit_Anhang()
On Error GoTo Err_Senden_mit_Anhang
Select Case Me![Objektart]
Case "Tabelle"
Select Case Me![Format]
Case "HTML"
DoCmd.SendObject acSendTable, Me![Objekt], acFormatHTML, Me![an], Me![cc], Me![bcc], Me![Betreff], Me![Mailinhalt], Me![Sende_KZ]
Case "RTF"
DoCmd.SendObject acSendTable, Me![Objekt], acFormatRTF, Me![an], Me![cc], Me![bcc], Me![Betreff], Me![Mailinhalt], Me![Sende_KZ]
Case "TXT"
DoCmd.SendObject acSendTable, Me![Objekt], acFormatTXT, Me![an], Me![cc], Me![bcc], Me![Betreff], Me![Mailinhalt], Me![Sende_KZ]
Case "XLS"
DoCmd.SendObject acSendTable, Me![Objekt], acFormatXLS, Me![an], Me![cc], Me![bcc], Me![Betreff], Me![Mailinhalt], Me![Sende_KZ]
End Select
Case "Abfrage"
Select Case Me![Format]
Case "HTML"
DoCmd.SendObject acSendQuery, Me![Objekt], acFormatHTML, Me![an], Me![cc], Me![bcc], Me![Betreff], Me![Mailinhalt], Me![Sende_KZ]
Case "RTF"
DoCmd.SendObject acSendQuery, Me![Objekt], acFormatRTF, Me![an], Me![cc], Me![bcc], Me![Betreff], Me![Mailinhalt], Me![Sende_KZ]
Case "TXT"
DoCmd.SendObject acSendQuery, Me![Objekt], acFormatTXT, Me![an], Me![cc], Me![bcc], Me![Betreff], Me![Mailinhalt], Me![Sende_KZ]
Case "XLS"
DoCmd.SendObject acSendQuery, Me![Objekt], acFormatXLS, Me![an], Me![cc], Me![bcc], Me![Betreff], Me![Mailinhalt], Me![Sende_KZ]
End Select
Case "Formular"
Select Case Me![Format]
Case "HTML"
DoCmd.SendObject acSendForm, Me![Objekt], acFormatHTML, Me![an], Me![cc], Me![bcc], Me![Betreff], Me![Mailinhalt], Me![Sende_KZ]
Case "RTF"
DoCmd.SendObject acSendForm, Me![Objekt], acFormatRTF, Me![an], Me![cc], Me![bcc], Me![Betreff], Me![Mailinhalt], Me![Sende_KZ]
Case "TXT"
DoCmd.SendObject acSendForm, Me![Objekt], acFormatTXT, Me![an], Me![cc], Me![bcc], Me![Betreff], Me![Mailinhalt], Me![Sende_KZ]
Case "XLS"
DoCmd.SendObject acSendForm, Me![Objekt], acFormatXLS, Me![an], Me![cc], Me![bcc], Me![Betreff], Me![Mailinhalt], Me![Sende_KZ]
End Select
Case "Bericht"
Select Case Me![Format]
Case "HTML"
DoCmd.SendObject acSendReport, Me![Objekt], acFormatHTML, Me![an], Me![cc], Me![bcc], Me![Betreff], Me![Mailinhalt], Me![Sende_KZ]
Case "RTF"
DoCmd.SendObject acSendReport, Me![Objekt], acFormatRTF, Me![an], Me![cc], Me![bcc], Me![Betreff], Me![Mailinhalt], Me![Sende_KZ]
Case "TXT"
DoCmd.SendObject acSendReport, Me![Objekt], acFormatTXT, Me![an], Me![cc], Me![bcc], Me![Betreff], Me![Mailinhalt], Me![Sende_KZ]
Case "XLS"
DoCmd.SendObject acSendReport, Me![Objekt], acFormatXLS, Me![an], Me![cc], Me![bcc], Me![Betreff], Me![Mailinhalt], Me![Sende_KZ]
End Select
Case "Modul"
DoCmd.SendObject acSendModule, Me![Objekt], acFormatTXT, Me![an], Me![cc], Me![bcc], Me![Betreff], Me![Mailinhalt], Me![Sende_KZ]
End Select
Exit_Senden_mit_Anhang:
Exit Sub
Err_Senden_mit_Anhang:
DoCmd.Hourglass False
MsgBox Err.Description
Resume Exit_Senden_mit_Anhang
End Sub
Private Sub Felder_löschen()
On Error GoTo Err_Felder_löschen
DoCmd.Hourglass True
Me![an] = Null
Me![cc] = Null
Me![bcc] = Null
Me![Betreff] = Null
Me![Mailinhalt] = Null
Me![Objektart] = Null
Me![Objekt] = Null
Me![Objekt].Visible = False
Me![Format] = "HTML"
Me![Format].Visible = False
DoCmd.SetWarnings False
DoCmd.RunSQL "DELETE tbl_AP_Mail_Manager_tmp_Email_an.* FROM tbl_AP_Mail_Manager_tmp_Email_an;"
DoCmd.RunSQL "DELETE tbl_AP_Mail_Manager_tmp_Email_cc.* FROM tbl_AP_Mail_Manager_tmp_Email_cc;"
DoCmd.RunSQL "DELETE tbl_AP_Mail_Manager_tmp_Email_bcc.* FROM tbl_AP_Mail_Manager_tmp_Email_bcc;"
DoCmd.SetWarnings True
DoCmd.Hourglass False
Exit_Felder_löschen:
Exit Sub
Err_Felder_löschen:
DoCmd.Hourglass False
MsgBox Err.Description
Resume Exit_Felder_löschen
End Sub
===========
Ich habe auch schon daran gedacht, daß hier etwas geändert werden muß, aber bisher keine Lösung gefunden.
===========
Ich habe eben diesen Code im DominoR6-Forum gefunden...
Wo müßte ich den im vorliegenden Formular einbauen?
Dim nSession As NotesSession
Dim dbDir As NotesDbDirectory
Dim mailDb As NotesDatabase
Dim mailDoc As NotesDocument
Dim body As NotesRichTextItem
nSesson = CreateObject("Lotus.NotesSession")
nSession.Initialize("password")
dbDir = nSession.GetDbDirectory(nSession.GetEnvironmentString("MailServer",True))
mailDb = dbDir.OpenMailDatabase
mailDoc = mailDb.CreateDocument
With mailDoc
.AppendItemValue("Form","Memo")
.AppendItemValue("SendTo",<addressees As String, String Array or Variant>)
.AppendItemValue("CopyTo",<similar>)
.AppendItemValue("BlindCopyTo",<similar>)
.AppendItemValue("Subject","Subject As String")
End With
body = mailDoc.CreateRichTextItem("Body")
body.AppendText("Message Text Goes Here")
mailDoc.Send(False)
body = Nothing
mailDoc = Nothing
mailDb = Nothing
============
wie ist damit zu verfahren?