Option Compare Database
Option Explicit
Public Const conAlsDatei As Integer = 0, conViaEMail As Integer = 1
Sub SnapOutputSend(intModus As Integer, _
strBerichtName As String, _
strPathOrEmail As String)
Dim strBetreff As String
Const conText = „Anbei wie besprochen der Bericht…“
Const conFormat = „Snapshot Format“
DoCmd.Hourglass True
strBetreff = „Bericht “ & strBerichtName
Select Case intModus
Case conAlsDatei
If Len(strPathOrEmail) > 0 Then
DoCmd.OutputTo acOutputReport, strBerichtName, conFormat, strPathOrEmail
DoEvents
Else
DoCmd.Hourglass False
Beep
MsgBox „Ausgabe in Datei nicht möglich, Pfad nicht angegeben!“, vbOKOnly + vbCritical, „!!! Fehler !!!“
Exit Sub
End If
Case conViaEMail
If Len(strPathOrEmail) > 0 Then
On Error Resume Next
DoCmd.SendObject acSendReport, strBerichtName, conFormat, strPathOrEmail, , , strBetreff, conText, False
DoEvents
If Err <> 0 Then
Beep
MsgBox „Versand via EMail nicht möglich, es ist ein Fehler aufgetreten!“, vbOKOnly + vbCritical, „!!! Fehler !!!“
End If
Else
DoCmd.Hourglass False
Beep
MsgBox „Versand via EMail nicht möglich, Empfänger nicht angegeben!“, vbOKOnly + vbCritical, „!!! Fehler !!!“
Exit Sub
End If
Case Else
Beep
MsgBox „OutputSend: Modus nicht angegeben!“, vbOKOnly + vbCritical, „!!! Fehler !!!“
End Select
DoEvents
DoCmd.Hourglass False
End Sub
Function AddSlash$(aPath$)
AddSlash = aPath
If Trim$(aPath) = „“ Then Exit Function
If Right$(aPath, 1) = „\“ Then Exit Function
AddSlash = aPath + „\“
End Function
Function PathOnly$(aPath$)
Dim L%
PathOnly = „“
If InStr(aPath$, „\“) = 0 Then Exit Function
L = Len(aPath$)
While Mid$(aPath$, L, 1) <> „\“ And L > 0
L = L – 1
Wend
If L > 1 Then PathOnly = Left$(aPath$, L)
End Function
Function GetDataBasePath() As String
Dim db As Database, L%, aPath$
Set db = CurrentDb()
aPath$ = db.Name
L = Len(aPath$)
While Mid$(aPath$, L, 1) <> „\“ And L > 0
L = L – 1
Wend
If L > 1 Then
aPath$ = Left$(aPath$, L)
Else
aPath$ = „“
End If
GetDataBasePath = aPath$
End Function