825 lines
25 KiB
Plaintext
825 lines
25 KiB
Plaintext
VERSION 5.00
|
|
Object = "{F9043C88-F6F2-101A-A3C9-08002B2F49FB}#1.2#0"; "comdlg32.ocx"
|
|
Object = "{831FDD16-0C5C-11D2-A9FC-0000F8754DA1}#2.2#0"; "MSCOMCTL.OCX"
|
|
Begin VB.Form frmMitteilungen
|
|
Caption = "Mitteilungen verfassen"
|
|
ClientHeight = 7620
|
|
ClientLeft = 60
|
|
ClientTop = 345
|
|
ClientWidth = 9495
|
|
LinkTopic = "Form1"
|
|
ScaleHeight = 7620
|
|
ScaleWidth = 9495
|
|
Begin VB.CommandButton cmdAlsGelesen
|
|
Caption = "als gelesen markieren"
|
|
Height = 375
|
|
Left = 3210
|
|
TabIndex = 21
|
|
Top = 6840
|
|
Width = 1755
|
|
End
|
|
Begin VB.CommandButton cmdPrint
|
|
Caption = "Drucken"
|
|
Height = 375
|
|
Left = 5190
|
|
TabIndex = 19
|
|
Top = 6840
|
|
Width = 1185
|
|
End
|
|
Begin MSComctlLib.StatusBar StatusBar1
|
|
Align = 2 'Unten ausrichten
|
|
Height = 315
|
|
Left = 0
|
|
TabIndex = 13
|
|
Top = 7305
|
|
Width = 9495
|
|
_ExtentX = 16748
|
|
_ExtentY = 556
|
|
Style = 1
|
|
_Version = 393216
|
|
BeginProperty Panels {8E3867A5-8586-11D1-B16A-00C0F0283628}
|
|
NumPanels = 1
|
|
BeginProperty Panel1 {8E3867AB-8586-11D1-B16A-00C0F0283628}
|
|
EndProperty
|
|
EndProperty
|
|
End
|
|
Begin VB.CommandButton cmdClose
|
|
Caption = "Schließen"
|
|
Height = 375
|
|
Left = 8190
|
|
TabIndex = 12
|
|
Top = 6840
|
|
Width = 1185
|
|
End
|
|
Begin VB.CommandButton cmdSenden
|
|
Caption = "Senden"
|
|
Height = 375
|
|
Left = 6660
|
|
TabIndex = 11
|
|
Top = 6810
|
|
Width = 1185
|
|
End
|
|
Begin VB.Frame Frame2
|
|
Caption = "Posteingang"
|
|
Height = 2265
|
|
Left = 0
|
|
TabIndex = 9
|
|
Top = 0
|
|
Width = 9465
|
|
Begin VB.CommandButton cmdNeu
|
|
Caption = "Neu"
|
|
Height = 375
|
|
Left = 1110
|
|
TabIndex = 17
|
|
Top = 1770
|
|
Width = 915
|
|
End
|
|
Begin VB.CommandButton cmdDelete
|
|
Caption = "Löschen"
|
|
Height = 375
|
|
Left = 120
|
|
TabIndex = 14
|
|
Top = 1770
|
|
Width = 915
|
|
End
|
|
Begin VB.ListBox lstMitteilungen
|
|
BeginProperty Font
|
|
Name = "Courier New"
|
|
Size = 8.25
|
|
Charset = 0
|
|
Weight = 400
|
|
Underline = 0 'False
|
|
Italic = 0 'False
|
|
Strikethrough = 0 'False
|
|
EndProperty
|
|
Height = 1320
|
|
Left = 120
|
|
TabIndex = 10
|
|
Top = 390
|
|
Width = 9255
|
|
End
|
|
Begin VB.Label LblUeberschrift
|
|
Caption = "Überschrift"
|
|
BeginProperty Font
|
|
Name = "Courier New"
|
|
Size = 8.25
|
|
Charset = 0
|
|
Weight = 400
|
|
Underline = 0 'False
|
|
Italic = 0 'False
|
|
Strikethrough = 0 'False
|
|
EndProperty
|
|
Height = 195
|
|
Left = 240
|
|
TabIndex = 20
|
|
Top = 210
|
|
Width = 8925
|
|
End
|
|
End
|
|
Begin VB.Frame Frame1
|
|
Caption = "Mitteilung"
|
|
Height = 4455
|
|
Left = 0
|
|
TabIndex = 0
|
|
Top = 2250
|
|
Width = 9465
|
|
Begin VB.TextBox txtDatum
|
|
Enabled = 0 'False
|
|
Height = 315
|
|
Left = 6780
|
|
Locked = -1 'True
|
|
TabIndex = 16
|
|
Top = 270
|
|
Width = 2355
|
|
End
|
|
Begin VB.CommandButton cmdLink
|
|
Caption = "Anlage"
|
|
Enabled = 0 'False
|
|
Height = 315
|
|
Left = 8400
|
|
TabIndex = 7
|
|
Top = 3960
|
|
Width = 765
|
|
End
|
|
Begin VB.TextBox txtLink
|
|
Height = 315
|
|
Left = 1020
|
|
Locked = -1 'True
|
|
TabIndex = 6
|
|
Top = 3990
|
|
Width = 7215
|
|
End
|
|
Begin VB.TextBox txtNachrichtentext
|
|
Height = 2325
|
|
Left = 150
|
|
Locked = -1 'True
|
|
MultiLine = -1 'True
|
|
ScrollBars = 2 'Vertikal
|
|
TabIndex = 5
|
|
Top = 1470
|
|
Width = 9045
|
|
End
|
|
Begin VB.TextBox txtBetreff
|
|
Height = 315
|
|
Left = 720
|
|
Locked = -1 'True
|
|
TabIndex = 4
|
|
Top = 690
|
|
Width = 8445
|
|
End
|
|
Begin VB.TextBox txtVon
|
|
Enabled = 0 'False
|
|
Height = 315
|
|
Left = 720
|
|
Locked = -1 'True
|
|
TabIndex = 2
|
|
Top = 270
|
|
Width = 3375
|
|
End
|
|
Begin VB.Label lblGelesen
|
|
BorderStyle = 1 'Fest Einfach
|
|
Height = 315
|
|
Left = 150
|
|
TabIndex = 18
|
|
Top = 1080
|
|
Width = 9015
|
|
End
|
|
Begin VB.Label Label4
|
|
Alignment = 1 'Rechts
|
|
Caption = "Gesendet am:"
|
|
Height = 255
|
|
Left = 5490
|
|
TabIndex = 15
|
|
Top = 330
|
|
Width = 1155
|
|
End
|
|
Begin VB.Label Label3
|
|
Caption = "Dokument:"
|
|
Height = 255
|
|
Left = 150
|
|
TabIndex = 8
|
|
Top = 4050
|
|
Width = 825
|
|
End
|
|
Begin VB.Label Label2
|
|
Caption = "Betreff:"
|
|
Height = 255
|
|
Left = 150
|
|
TabIndex = 3
|
|
Top = 720
|
|
Width = 615
|
|
End
|
|
Begin VB.Label Label1
|
|
Caption = "Von:"
|
|
Height = 255
|
|
Left = 150
|
|
TabIndex = 1
|
|
Top = 330
|
|
Width = 405
|
|
End
|
|
End
|
|
Begin MSComDlg.CommonDialog CommonDialog1
|
|
Left = 630
|
|
Top = 6690
|
|
_ExtentX = 847
|
|
_ExtentY = 847
|
|
_Version = 393216
|
|
End
|
|
End
|
|
Attribute VB_Name = "frmMitteilungen"
|
|
Attribute VB_GlobalNameSpace = False
|
|
Attribute VB_Creatable = False
|
|
Attribute VB_PredeclaredId = True
|
|
Attribute VB_Exposed = False
|
|
Option Explicit
|
|
|
|
|
|
Private m_blnDieseNachrichtHatUngeleseneAnlagen As Boolean
|
|
Private m_blnEsGibtUngeleseneNachrichten As Boolean
|
|
|
|
|
|
Private Const TEXTREADONLY = "Mitteilungen lesen"
|
|
Private Const TEXTEDIT = "Mitteilungen bearbeiten"
|
|
|
|
Private Const TEXTOPEN = "öffnen..."
|
|
Private Const TEXTLINK = "Link..."
|
|
|
|
Private Enum enumStatus
|
|
keine = 0
|
|
NEU = 1
|
|
bearbeitet = 2
|
|
gesendet = 3
|
|
End Enum
|
|
|
|
Private m_StatusMitteilung As enumStatus
|
|
|
|
Private Sub cmdAlsGelesen_Click()
|
|
Dim lngID As Long
|
|
lngID = GetMsgID(lstMitteilungen.text)
|
|
|
|
If lngID > 0 Then
|
|
If m_blnDieseNachrichtHatUngeleseneAnlagen = True Then
|
|
MsgBox "Bitte lesen Sie auch das angehängte Dokument."
|
|
End If
|
|
AlsGelesenMarkieren lngID
|
|
End If
|
|
End Sub
|
|
|
|
|
|
Private Sub AlsGelesenMarkieren(lngID As Long)
|
|
Dim strSQL As String
|
|
Dim rs As CRecordset
|
|
|
|
strSQL = "SELECT * FROM GeleseneMitteilungen WHERE NachrichtID=" & lngID & " AND MitarbeiterNr=" & g_App.Mitarbeiter.getNr
|
|
Set rs = New CRecordset
|
|
rs.openRS strSQL, False
|
|
If rs.EOF Then
|
|
rs.addNew
|
|
rs.setValue "NachrichtID", lngID
|
|
rs.setValue "MitarbeiterNr", g_App.Mitarbeiter.getNr
|
|
rs.setValue "gelesenDatum", Now()
|
|
rs.update
|
|
cmdAlsGelesen.Enabled = False
|
|
LadeNachrichtenUebersicht
|
|
Else
|
|
LogIntoDB "cmdAlsGelesen_Click: rs ist nicht eof", "unerwartet"
|
|
Debug.Print
|
|
End If
|
|
End Sub
|
|
|
|
|
|
Private Function CheckForUngeleseneNachrichten() As Boolean
|
|
LadeNachrichtenUebersicht
|
|
If m_blnEsGibtUngeleseneNachrichten Then
|
|
' MSgbox ist nicht erreichtbar, wenn nach einer Referenzzählerprfung
|
|
' das Login- und das Mittteilungsfenster Fenster erschienen ist
|
|
' MsgBox "Es gibt ungelesene Nachrichten."
|
|
CheckForUngeleseneNachrichten = True
|
|
Else
|
|
CheckForUngeleseneNachrichten = False
|
|
End If
|
|
End Function
|
|
|
|
Private Sub cmdClose_Click()
|
|
If CheckForUngeleseneNachrichten() = False Then
|
|
|
|
End If
|
|
Unload Me
|
|
End Sub
|
|
|
|
Private Sub cmdDelete_Click()
|
|
Dim lngID As Long
|
|
Dim strSQL As String
|
|
|
|
m_StatusMitteilung = keine
|
|
|
|
lngID = GetMsgID(lstMitteilungen.text)
|
|
|
|
|
|
If MsgBox("Sind Sie sicher, daß sie diese Nachricht (" & lngID & ") für alle Empfänger löschen wollen?", vbOKCancel Or vbDefaultButton2) = vbCancel Then
|
|
Exit Sub
|
|
End If
|
|
|
|
strSQL = "DELETE FROM GeleseneMitteilungen WHERE (MitarbeiterNr = " & g_App.Mitarbeiter.getNr & ") And (NachrichtID = " & lngID & ")"
|
|
g_App.getDB.getConnection.Execute strSQL
|
|
|
|
|
|
strSQL = "DELETE FROM Mitteilungen where NachrichtID = " & lngID
|
|
g_App.getDB.getConnection.Execute strSQL
|
|
|
|
|
|
LadeNachrichtenUebersicht
|
|
|
|
lstMitteilungen_Click
|
|
End Sub
|
|
|
|
Private Sub cmdLink_Click()
|
|
If cmdLink.Caption = TEXTLINK Then
|
|
CommonDialog1.ShowOpen
|
|
txtLink = CommonDialog1.filename
|
|
Else
|
|
OpenDocument txtLink.text
|
|
m_blnDieseNachrichtHatUngeleseneAnlagen = False
|
|
End If
|
|
|
|
Dim lngID As Long
|
|
lngID = GetMsgID(lstMitteilungen.text)
|
|
AlsGelesenMarkieren lngID
|
|
|
|
End Sub
|
|
|
|
|
|
Private Sub cmdNeu_Click()
|
|
m_StatusMitteilung = NEU
|
|
If lstMitteilungen.ListIndex > -1 Then
|
|
lstMitteilungen.Selected(lstMitteilungen.ListIndex) = False
|
|
End If
|
|
|
|
ClearEingaben
|
|
|
|
txtDatum.text = Format(Now(), "dd.mm.yyyy hh:mm")
|
|
txtVon.text = g_App.Mitarbeiter.getVorname & " " & g_App.Mitarbeiter.getName
|
|
lblGelesen.Caption = "Diese Mitteilung wurde noch nicht gesendet."
|
|
|
|
|
|
cmdLink.Caption = TEXTLINK
|
|
cmdLink.Enabled = True
|
|
|
|
ErlaubeEmailEingabe True
|
|
txtBetreff.SetFocus
|
|
End Sub
|
|
|
|
Private Sub cmdPrint_Click()
|
|
Dim strText As String
|
|
|
|
Printer.ScaleMode = vbMillimeters
|
|
Printer.ScaleTop = -10
|
|
Printer.ScaleLeft = -15
|
|
|
|
Printer.Font.Size = 12
|
|
|
|
Printer.CurrentX = 0
|
|
Printer.Print "QM Mitteilung für " & g_App.Mitarbeiter.getVorname & g_App.Mitarbeiter.getName
|
|
Printer.Line (0, Printer.CurrentY)-(Printer.ScaleWidth - 30, Printer.CurrentY)
|
|
|
|
Printer.Print vbCrLf
|
|
|
|
Printer.Font.Size = 10
|
|
Printer.CurrentX = 0
|
|
strText = "Von: "
|
|
strText = AddTextInPosition(strText, txtVon.text, 10)
|
|
Printer.Print strText
|
|
|
|
Printer.CurrentX = 0
|
|
strText = "Gesendet: "
|
|
strText = AddTextInPosition(strText, txtDatum.text, 10)
|
|
Printer.Print strText
|
|
|
|
Printer.CurrentX = 0
|
|
strText = "Anlage: "
|
|
strText = AddTextInPosition(strText, txtLink.text, 10)
|
|
Printer.Print strText
|
|
|
|
Printer.CurrentX = 0
|
|
Printer.Print vbCrLf & vbCrLf
|
|
Printer.Print txtNachrichtentext.text
|
|
|
|
Printer.EndDoc
|
|
End Sub
|
|
|
|
Private Sub cmdSenden_Click()
|
|
cmdSenden.Enabled = False
|
|
Me.MousePointer = vbHourglass
|
|
Call SendeNachricht
|
|
|
|
lblGelesen.Caption = "Gesendet"
|
|
MsgBox "Nachricht wurde gesendet."
|
|
|
|
txtBetreff.text = ""
|
|
txtNachrichtentext.text = ""
|
|
txtLink.text = ""
|
|
lblGelesen.Caption = ""
|
|
txtDatum.text = ""
|
|
|
|
m_StatusMitteilung = gesendet
|
|
|
|
LadeNachrichtenUebersicht
|
|
m_StatusMitteilung = keine
|
|
ErlaubeEmailEingabe False
|
|
Me.MousePointer = vbNormal
|
|
End Sub
|
|
|
|
Private Sub Form_Activate()
|
|
LadeNachrichtenUebersicht
|
|
End Sub
|
|
|
|
Private Sub Form_Load()
|
|
cmdSenden.Enabled = False
|
|
cmdDelete.Enabled = False
|
|
cmdPrint.Enabled = False
|
|
cmdAlsGelesen.Enabled = False
|
|
|
|
m_StatusMitteilung = keine
|
|
|
|
If HatMitarbeiterRecht("AV_MITTEILUNGEN") Then
|
|
cmdNeu.Enabled = True
|
|
Me.Caption = TEXTEDIT
|
|
Else
|
|
Me.Caption = TEXTREADONLY
|
|
cmdNeu.Enabled = False
|
|
End If
|
|
|
|
Me.Width = 9630
|
|
Me.Height = 8025
|
|
|
|
End Sub
|
|
|
|
Private Sub Form_QueryUnload(Cancel As Integer, UnloadMode As Integer)
|
|
' If CheckForUngeleseneNachrichten() = True And UnloadMode = 0 Then
|
|
' 'Cancel = 1
|
|
' End If
|
|
End Sub
|
|
|
|
Private Sub Form_Resize()
|
|
On Error Resume Next
|
|
|
|
If Me.WindowState = 0 Then
|
|
Me.Width = 9630
|
|
Me.Height = 8025
|
|
End If
|
|
|
|
End Sub
|
|
|
|
|
|
Private Sub CheckIfSendenErlaubt()
|
|
cmdSenden.Enabled = False
|
|
If Trim(txtBetreff.text) <> "" Then
|
|
If Trim(txtNachrichtentext.text) <> "" Then
|
|
cmdSenden.Enabled = True
|
|
End If
|
|
End If
|
|
End Sub
|
|
|
|
Private Sub CheckLoeschenErlaubt()
|
|
cmdDelete.Enabled = False
|
|
If lstMitteilungen.ListCount > 0 Then
|
|
cmdDelete.Enabled = True
|
|
End If
|
|
End Sub
|
|
|
|
Private Sub SendeNachricht()
|
|
Dim strSQL As String
|
|
Dim rs As CRecordset
|
|
|
|
strSQL = "SELECT * FROM Mitteilungen WHERE NachrichtID = -1"
|
|
Set rs = New CRecordset
|
|
rs.openRS strSQL, False
|
|
If rs.EOF Then
|
|
rs.addNew
|
|
Else
|
|
MsgBox "Nachricht " & rs.getLongValue("NachrichtID") & " ist vorhanden"
|
|
Exit Sub
|
|
End If
|
|
rs.setValue "Verfasser", g_App.Mitarbeiter.getNr
|
|
rs.setValue "Betreff", txtBetreff.text
|
|
rs.setValue "Nachricht", txtNachrichtentext.text
|
|
|
|
rs.setValue "Link", txtLink.text & ""
|
|
|
|
rs.setValue "Datum", Now()
|
|
rs.update
|
|
|
|
rs.openRS "SELECT @@IDENTITY as ID ", True
|
|
Dim lngID As Long
|
|
lngID = rs.getLongValue("ID")
|
|
Debug.Print lngID
|
|
AlsGelesenMarkieren lngID
|
|
|
|
End Sub
|
|
|
|
|
|
Private Sub lstMitteilungen_Click()
|
|
Dim lngID As Long
|
|
|
|
ClearEingaben
|
|
|
|
lngID = GetMsgID(lstMitteilungen.text)
|
|
NachrichtAnzeigen (lngID)
|
|
cmdSenden.Enabled = False
|
|
|
|
If lstMitteilungen.Enabled = False Then Exit Sub
|
|
|
|
If m_StatusMitteilung = bearbeitet Then
|
|
MsgBox "Sie haben die Mitteilung noch nicht gesendet."
|
|
If cmdSenden.Enabled = True Then
|
|
cmdSenden.SetFocus
|
|
End If
|
|
m_StatusMitteilung = keine
|
|
Exit Sub
|
|
End If
|
|
|
|
End Sub
|
|
|
|
Private Sub lstMitteilungen_DblClick()
|
|
If GetMsgID(lstMitteilungen.text) > 0 Then
|
|
If HatMitarbeiterRecht("AV_MITTEILUNGEN") Then
|
|
ZeigeMitarbeiterMitteilungGelesen GetMsgID(lstMitteilungen.text)
|
|
End If
|
|
End If
|
|
End Sub
|
|
|
|
Private Sub txtBetreff_Change()
|
|
If m_StatusMitteilung = NEU And txtBetreff.text <> "" Then
|
|
m_StatusMitteilung = bearbeitet
|
|
End If
|
|
|
|
CheckIfSendenErlaubt
|
|
End Sub
|
|
|
|
Private Sub txtLink_Change()
|
|
If m_StatusMitteilung = NEU And txtLink.text <> "" Then
|
|
m_StatusMitteilung = bearbeitet
|
|
End If
|
|
End Sub
|
|
|
|
Private Sub txtNachrichtentext_Change()
|
|
If m_StatusMitteilung = NEU And txtNachrichtentext.text <> "" Then
|
|
m_StatusMitteilung = bearbeitet
|
|
End If
|
|
|
|
CheckIfSendenErlaubt
|
|
End Sub
|
|
|
|
Private Sub LadeNachrichtenUebersicht()
|
|
Dim strSQL As String
|
|
Dim rs As CRecordset
|
|
Dim strText As String
|
|
Dim Mitarbeiter As CMitarbeiter
|
|
|
|
m_blnEsGibtUngeleseneNachrichten = False
|
|
|
|
lstMitteilungen.Clear
|
|
|
|
lblUeberschrift.Caption = "Id"
|
|
lblUeberschrift.Caption = AddTextInPosition(lblUeberschrift.Caption, "Neu", 6)
|
|
lblUeberschrift.Caption = AddTextInPosition(lblUeberschrift.Caption, "Betreff", 10)
|
|
lblUeberschrift.Caption = AddTextInPosition(lblUeberschrift.Caption, "Absender", 57)
|
|
lblUeberschrift.Caption = AddTextInPosition(lblUeberschrift.Caption, "Datum", 68)
|
|
|
|
'lstMitteilungen.AddItem "0123456789012345678901234567890123456789012345678901234567890123456789012345678901234567890123456789012345678901234567890"
|
|
|
|
' ungelesene
|
|
strSQL = "SELECT * from Mitteilungen "
|
|
strSQL = strSQL & "WHERE NachrichtID NOT IN (SELECT NachrichtID FROM GeleseneMitteilungen WHERE MitarbeiterNr = " & g_App.Mitarbeiter.getNr & ") "
|
|
strSQL = strSQL & "ORDER BY Mitteilungen.Datum DESC "
|
|
|
|
Set rs = New CRecordset
|
|
Debug.Print "LadeNachrichtenUebersicht " & vbCrLf & strSQL
|
|
rs.openRS strSQL, True
|
|
Do While Not rs.EOF
|
|
m_blnEsGibtUngeleseneNachrichten = True
|
|
|
|
strText = rs.getLongValue("NachrichtID")
|
|
strText = AddTextInPosition(strText, "*", 7)
|
|
strText = AddTextInPosition(strText, Left(rs.getStringValue("Betreff"), 40), 9)
|
|
|
|
Set Mitarbeiter = New CMitarbeiter
|
|
Mitarbeiter.loadForNr rs.getStringValue("Verfasser")
|
|
strText = AddTextInPosition(strText, Left(Left(Mitarbeiter.getVorname, 1) & "." & Mitarbeiter.getName, 11), 57)
|
|
strText = AddTextInPosition(strText, Format(rs.getDateValue("Datum"), "dd.mm.yyyy hh:mm"), 68)
|
|
lstMitteilungen.AddItem strText
|
|
rs.MoveNext
|
|
Loop
|
|
|
|
lstMitteilungen.Enabled = False
|
|
lstMitteilungen.ListIndex = lstMitteilungen.ListCount - 1
|
|
lstMitteilungen.Enabled = True
|
|
|
|
' gelesene
|
|
strSQL = "SELECT Mitteilungen.* from Mitteilungen "
|
|
strSQL = strSQL & "INNER JOIN GeleseneMitteilungen ON GeleseneMitteilungen.NachrichtID = Mitteilungen.NachrichtID "
|
|
strSQL = strSQL & "WHERE(GeleseneMitteilungen.MitarbeiterNr = " & g_App.Mitarbeiter.getNr & ")"
|
|
strSQL = strSQL & "ORDER BY Mitteilungen.Datum DESC "
|
|
|
|
Set rs = New CRecordset
|
|
Debug.Print "LadeNachrichtenUebersicht " & vbCrLf & strSQL
|
|
rs.openRS strSQL, True
|
|
Do While Not rs.EOF
|
|
strText = rs.getLongValue("NachrichtID")
|
|
strText = AddTextInPosition(strText, Left(rs.getStringValue("Betreff"), 40), 9)
|
|
|
|
Set Mitarbeiter = New CMitarbeiter
|
|
Mitarbeiter.loadForNr rs.getStringValue("Verfasser")
|
|
strText = AddTextInPosition(strText, Left(Left(Mitarbeiter.getVorname, 1) & "." & Mitarbeiter.getName, 11), 57)
|
|
strText = AddTextInPosition(strText, Format(rs.getDateValue("Datum"), "dd.mm.yyyy hh:mm"), 68)
|
|
lstMitteilungen.AddItem strText
|
|
rs.MoveNext
|
|
Loop
|
|
End Sub
|
|
|
|
|
|
Private Function AddTextInPosition(strText As String, strNeuerText As String, Position As Integer) As String
|
|
AddTextInPosition = Left(strText & Space(Position), Position) & strNeuerText
|
|
|
|
If Len(strText) > Position + Len(strNeuerText) Then
|
|
AddTextInPosition = Left(AddTextInPosition, Len(strNeuerText) + Position) + Mid(strText, Position)
|
|
End If
|
|
|
|
End Function
|
|
|
|
Private Sub NachrichtAnzeigen(lngID As Long)
|
|
Dim strSQL As String
|
|
Dim rs As CRecordset
|
|
Dim datDatumGelesen As Date
|
|
Dim Mitarbeiter As CMitarbeiter
|
|
|
|
cmdDelete.Enabled = False
|
|
|
|
cmdAlsGelesen.Enabled = False
|
|
|
|
strSQL = "SELECT * FROM Mitteilungen "
|
|
strSQL = strSQL & "WHERE Mitteilungen.NachrichtID = " & lngID
|
|
|
|
Set rs = New CRecordset
|
|
rs.openRS strSQL, True
|
|
If Not rs.EOF Then
|
|
ErlaubeEmailEingabe False
|
|
|
|
Set Mitarbeiter = New CMitarbeiter
|
|
Mitarbeiter.loadForNr rs.getStringValue("Verfasser")
|
|
txtVon.text = Mitarbeiter.getVorname & " " & Mitarbeiter.getName
|
|
|
|
txtBetreff.text = rs.getStringValue("Betreff")
|
|
txtNachrichtentext.text = rs.getStringValue("Nachricht")
|
|
|
|
txtLink.text = rs.getStringValue("Link")
|
|
|
|
' lokale Laufwerke
|
|
txtLink.text = Replace(UCase(txtLink.text), UCase("F:\QM-Dokumente\"), "\\sla12file\Qualitätsmanagement\QM-Dokumente\")
|
|
txtLink.text = Replace(UCase(txtLink.text), UCase("A:\QM-Dokumente\"), "\\sla12file\Qualitätsmanagement\QM-Dokumente\")
|
|
|
|
|
|
txtDatum.text = rs.getDateValue("Datum")
|
|
|
|
cmdLink.Caption = TEXTOPEN
|
|
cmdLink.Enabled = True
|
|
|
|
If g_App.Mitarbeiter.getNr = rs.getLongValue("Verfasser") Then
|
|
cmdDelete.Enabled = True
|
|
End If
|
|
|
|
If Trim(txtLink.text) = "" Then
|
|
cmdLink.Enabled = False
|
|
End If
|
|
|
|
If IstNachrichtGelesen(lngID, datDatumGelesen) = False Then
|
|
lblGelesen.Caption = "ungelesen"
|
|
cmdAlsGelesen.Enabled = True
|
|
If txtLink.text = "" Then
|
|
' Es gibt keine Anlagen
|
|
m_blnDieseNachrichtHatUngeleseneAnlagen = False
|
|
Else
|
|
m_blnDieseNachrichtHatUngeleseneAnlagen = True
|
|
End If
|
|
Else
|
|
lblGelesen = "Sie haben diese Mitteilung am " & Format(datDatumGelesen, "dd.mm.yyyy hh:mm") & " gelesen."
|
|
cmdAlsGelesen.Enabled = False
|
|
End If
|
|
|
|
cmdPrint.Enabled = True
|
|
End If
|
|
End Sub
|
|
|
|
Private Sub ErlaubeEmailEingabe(blnErlaube As Boolean)
|
|
txtBetreff.Locked = Not blnErlaube
|
|
txtNachrichtentext.Locked = Not blnErlaube
|
|
txtLink.Locked = Not blnErlaube
|
|
cmdLink.Enabled = blnErlaube
|
|
End Sub
|
|
|
|
Private Sub OpenDocument(strPfad As String)
|
|
On Error GoTo Errorhandler
|
|
|
|
Dim cFileName As String
|
|
Dim cDirName As String
|
|
Dim lRet As Long
|
|
Dim cExecute As String
|
|
Dim strExtension As String
|
|
|
|
cFileName = Trim(strPfad)
|
|
cDirName = ""
|
|
strExtension = getextension(cDirName & cFileName)
|
|
|
|
Select Case LCase(strExtension)
|
|
Case "bat", "cmd", "pif", "scr", "exe", "com", "vbs"
|
|
MsgBox "Ausführbare Dateien können aus Sicherheitsgründen nicht geöffnet werden."
|
|
Exit Sub
|
|
Case Else
|
|
' In der Vergangenheit wurden falsche Pfade eingegeben und einige Pfade haben sich geändert.
|
|
|
|
cFileName = Replace(UCase(cFileName), UCase("\\la--01\"), "\\sla12file\")
|
|
cFileName = Replace(UCase(cFileName), UCase("F:\QM-Dokumente\"), "\\sla12file\Qualitätsmanagement\QM-Dokumente\")
|
|
cFileName = Replace(UCase(cFileName), UCase("A:\QM-Dokumente\"), "\\sla12file\Qualitätsmanagement\QM-Dokumente\")
|
|
cFileName = Replace(UCase(cFileName), UCase("A:\LISTE DER QM-DOKUMENTE\"), "\\sla12file\Qualitätsmanagement\Liste der QM-Dokumente\")
|
|
|
|
cFileName = LCase(cFileName)
|
|
If Left(cFileName, 5) <> "http:" Then
|
|
If Dir(cFileName) = "" Then
|
|
MsgBox "Diese Datei existiert nicht an diesem Ort."
|
|
Exit Sub
|
|
End If
|
|
End If
|
|
lRet = ShellExecute(0, "open", cFileName, 0, 0, 1)
|
|
End Select
|
|
Exit Sub
|
|
Errorhandler:
|
|
Dim strErrText As String
|
|
strErrText = "Fehler " & Err.Number & " in Opendocument():" & Err.Description
|
|
LogIntoDB strErrText, "Mitteilungen"
|
|
MsgBox strErrText
|
|
Exit Sub
|
|
Resume
|
|
End Sub
|
|
|
|
Private Sub OpenUrl(ByVal url As String)
|
|
Dim r As Long
|
|
r = ShellExecute(0, "open", url, 0, 0, 1)
|
|
End Sub
|
|
|
|
|
|
|
|
Private Function IstNachrichtGelesen(lngID As Long, ByRef datDatumGelesen As Date) As Boolean
|
|
Dim strSQL As String
|
|
Dim rs As CRecordset
|
|
|
|
strSQL = "SELECT gelesenDatum FROM GeleseneMitteilungen WHERE (NachrichtID = " & lngID & ") AND (MitarbeiterNr = " & g_App.Mitarbeiter.getNr & ")"
|
|
Set rs = New CRecordset
|
|
rs.openRS strSQL, True
|
|
If Not rs.EOF Then
|
|
IstNachrichtGelesen = True
|
|
datDatumGelesen = rs.getDateValue("gelesenDatum")
|
|
End If
|
|
End Function
|
|
|
|
|
|
Private Sub ClearEingaben()
|
|
txtBetreff.text = ""
|
|
txtDatum.text = ""
|
|
txtLink.text = ""
|
|
txtNachrichtentext.text = ""
|
|
txtVon.text = ""
|
|
End Sub
|
|
|
|
Private Sub ZeigeMitarbeiterMitteilungGelesen(lngID As Long)
|
|
Dim strSQL As String
|
|
Dim strMeldung As String
|
|
Dim rs As CRecordset
|
|
|
|
strSQL = ""
|
|
strSQL = strSQL & "SELECT Mitarbeiter.Vorname, Mitarbeiter.Name, Mitarbeiter.MitarbeiterNr "
|
|
strSQL = strSQL & "FROM GeleseneMitteilungen "
|
|
strSQL = strSQL & "INNER JOIN Mitarbeiter ON GeleseneMitteilungen.MitarbeiterNr = Mitarbeiter.MitarbeiterNr "
|
|
strSQL = strSQL & "WHERE (GeleseneMitteilungen.NachrichtID = " & lngID & ") AND "
|
|
strSQL = strSQL & "Mitarbeiter.MitarbeiterNr <> " & g_App.Mitarbeiter.getNr
|
|
strSQL = strSQL & "ORDER BY Mitarbeiter.Name, Mitarbeiter.Vorname "
|
|
|
|
Set rs = New CRecordset
|
|
rs.openRS strSQL, True
|
|
If Not rs.EOF Then
|
|
strMeldung = "Diese Nachricht wurde 'als gelesen' markiert von " & rs.RecordCount & " Personen:" & vbCrLf
|
|
Do While Not rs.EOF
|
|
strMeldung = strMeldung & rs.getStringValue("Vorname") & " " & rs.getStringValue("Name") & " (" & rs.getLongValue("MitarbeiterNr") & "), "
|
|
rs.MoveNext
|
|
Loop
|
|
strMeldung = Left(strMeldung, Len(strMeldung) - 2)
|
|
Else
|
|
strMeldung = strMeldung & "Diese Nachricht wurde noch nicht gelesen."
|
|
End If
|
|
MsgBox strMeldung
|
|
End Sub
|
|
|
|
Private Function GetMsgID(strAuswahl As String) As Integer
|
|
GetMsgID = Val(Left(lstMitteilungen.text, 7))
|
|
End Function
|
|
|