Hallo Franz,
vielen Dank für die erste Antwort. Natürlich ist das nicht der gesamte Code. Ich dachte nur, daß schon die Deklarationen vielleicht anders wären
Hier das Gesamte:
On Error GoTo fncSendEmail_Err
Dim strProcName As String
Dim strTo As String
Dim strBCC As String
Dim strThema As String
Dim strDummy As String
Dim strBodyEnd As String
Dim strGrussformel As String
Dim dbs As DAO.Database
Dim rst As Recordset
’ Variablenzuweisung
strProcName = „fncSendEmail“
strTo = " anfrage Nr"
strBodyEnd = „Ihr Angebot erwarte ich bis zum:“
strGrussformel = „Mit freundlichem Gruß“
Set dbs = CurrentDb
Set rst = dbs.OpenRecordset(„SELECT * FROM Anfragekopf WHERE bolGesendet = 0“, dbOpenDynaset)
With rst
'Schleife durch alle Datensätze
Do Until .EOF
’ BCC Auslesen
strBCC = Nz(rst.Fields(„LieferantenderAnfrage“))
’ Betreff erstellen
strThema = "Anfrage Nr. " & Nz(rst.Fields(„AnfrageNrAFK“)) & Nz(rst.Fields(„AnfragerKZ“))
’ Body erstellen
strDummy = "Anfrage Nr " & Nz(rst.Fields(„AnfrageNrAFK“)) & Nz(rst.Fields(„AnfragerKZ“)) & vbCrLf & vbCrLf
’ Anrede und Anfragetext erstellen
strDummy = strDummy & Nz(rst.Fields(„Anfragetext“)) & vbCrLf & vbCrLf
’ Teiletexte erstellen
strDummy = strDummy & fncGetTeile(Nz(rst.Fields(„AnfrageNrAFK“), 0))
’ Angebotstermintext erstellen
strDummy = strDummy & vbCrLf & vbCrLf & strBodyEnd & vbTab & Nz(Format(rst.Fields(„TerminAnfrage“), „dd.mm.yyyy“)) & vbCrLf & vbCrLf
’ Grussformel hinzufügen
strDummy = strDummy & strGrussformel & vbCrLf & Nz(rst.Fields(„AnfragerAFK“))
’ Email senden
DoCmd.SendObject acSendNoObject, , , strTo, , strBCC, strThema, strDummy, True
'Nächster Datensatz
.MoveNext
Loop
End With
fncSendEmail = True
'Fehlerbehandlung
fncSendEmail_Exit:
On Error Resume Next
rst.Close
Set rst = Nothing
Set dbs = Nothing
Exit Function
fncSendEmail_Err:
Select Case Err
Case 2501
’ Die Email wurde nicht gesendet
msgbox „Abbruch durch den Benutzer.“ & vbCrLf & „Die Email wurde nicht versendet.“, vbExclamation, „Email versenden“
Resume Next
Case Else
’ Anderer Fehler
msgbox „Es ist ein Fehler aufgetreten.“ & vbCrLf & vbCrLf & _
„In Function:“ & vbTab & strProcName & vbCrLf & _
„Fehlernummer:“ & vbTab & Err.Number & vbCrLf & _
„Beschreibung:“ & vbTab & Err.Description, vbCritical, _
"Fehler in " & Chr$(34) & strProcName & Chr$(34)
End Select
fncSendEmail = False
Resume fncSendEmail_Exit
End Function
Function fncGetTeile(AnfrageNrAFK As Long) As String
Dim strDummy As String
Dim strPostText As String
Dim lngPosLen As Long
Dim strProcName As String
strProcName = „fncGetTeile“
On Error GoTo fncGetTeile_Err
Dim dbs As DAO.Database
Dim rst As DAO.Recordset
Set dbs = CurrentDb()
Set rst = dbs.OpenRecordset(„SELECT * FROM Anfragepositonen WHERE AnfragenNrPos = " & AnfrageNrAFK & " ORDER BY Anfrageposition“, dbOpenDynaset)
Do While Not rst.EOF
strPostText = „Pos.“ & Format(Nz(rst.Fields(„Anfrageposition“)), " 00") & " "
lngPosLen = Len(strPostText)
strDummy = strDummy & strPostText
strDummy = strDummy & „Teilenummer“ & vbTab & Nz(rst.Fields(„TeilenrAF“)) & vbCrLf
strDummy = strDummy & Space(lngPosLen) & „Teiletext“ & vbTab & vbTab & Nz(rst.Fields(„TeiletextAF“)) & vbCrLf
strDummy = strDummy & Space(lngPosLen) & „Zeichnung“ & vbTab & vbTab & Nz(rst.Fields(„ZeichnungAF“)) & vbCrLf
strDummy = strDummy & vbCrLf
’ Menge1
If Nz(rst.Fields(„Menge1“), 0) > 0 Then
strDummy = strDummy & Space(lngPosLen) & „Menge“ & vbTab & vbTab & Nz(Format(rst.Fields(„Menge1“), „#,##0“)) & " " & Nz(rst.Fields(„MEAF“)) & vbCrLf
End If
’ Menge2
If Nz(rst.Fields(„Menge2“), 0) > 0 Then
strDummy = strDummy & Space(lngPosLen) & „Menge“ & vbTab & vbTab & Nz(Format(rst.Fields(„Menge2“), „#,##0“)) & " " & Nz(rst.Fields(„MEAF“)) & vbCrLf
End If
'Menge3
If Nz(rst.Fields(„Menge3“), 0) > 0 Then
strDummy = strDummy & Space(lngPosLen) & „Menge“ & vbTab & vbTab & Nz(Format(rst.Fields(„Menge3“), „#,##0“)) & " " & Nz(rst.Fields(„MEAF“)) & vbCrLf
End If
’ Menge4
If Nz(rst.Fields(„Menge4“), 0) > 0 Then
strDummy = strDummy & Space(lngPosLen) & „Menge“ & vbTab & vbTab & Nz(Format(rst.Fields(„Menge4“), „#,##0“)) & " " & Nz(rst.Fields(„MEAF“)) & vbCrLf
End If
’ Menge5
If Nz(rst.Fields(„Menge5“), 0) > 0 Then
strDummy = strDummy & Space(lngPosLen) & „Menge“ & vbTab & vbTab & Nz(Format(rst.Fields(„Menge5“), „#,##0“)) & " " & Nz(rst.Fields(„MEAF“)) & vbCrLf
End If
strDummy = strDummy & vbCrLf
rst.MoveNext
Loop
'Fehlerbehandlung
fncGetTeile_Exit:
On Error Resume Next
rst.Close
Set rst = Nothing
Set dbs = Nothing
fncGetTeile = strDummy
Exit Function
fncGetTeile_Err:
Select Case Err
Case Else
msgbox „Es ist ein Fehler aufgetreten.“ & vbCrLf & vbCrLf & _
„In Function:“ & vbTab & strProcName & vbCrLf & _
„Fehlernummer:“ & vbTab & Err.Number & vbCrLf & _
„Beschreibung:“ & vbTab & Err.Description, vbCritical, _
"Fehler in " & Chr$(34) & strProcName & Chr$(34)
Resume fncGetTeile_Exit
End Select
End Function
