VERSION 5.00 Begin VB.Form Form1 BackColor = &H00C0FFFF& Caption = "Form1" ClientHeight = 6720 ClientLeft = 48 ClientTop = 288 ClientWidth = 8376 LinkTopic = "Form1" ScaleHeight = 6720 ScaleWidth = 8376 StartUpPosition = 3 'Windows-Standard Begin VB.TextBox txtFirma DataSource = "AdodcAdressen" BeginProperty Font Name = "Arial" Size = 10.2 Charset = 0 Weight = 400 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty Height = 372 Left = 2280 TabIndex = 0 Top = 720 Width = 5052 End Begin VB.TextBox txtPLZ DataSource = "AdodcAdressen" BeginProperty Font Name = "Arial" Size = 10.2 Charset = 0 Weight = 400 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty Height = 372 Left = 2280 TabIndex = 3 Top = 2160 Width = 732 End Begin VB.TextBox txtStraße DataSource = "AdodcAdressen" BeginProperty Font Name = "Arial" Size = 10.2 Charset = 0 Weight = 400 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty Height = 372 Left = 2280 TabIndex = 2 Top = 1680 Width = 5052 End Begin VB.TextBox txtName DataSource = "AdodcAdressen" BeginProperty Font Name = "Arial" Size = 10.2 Charset = 0 Weight = 400 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty Height = 372 Left = 2280 TabIndex = 1 Top = 1200 Width = 5052 End Begin VB.TextBox txtOrt DataSource = "AdodcAdressen" BeginProperty Font Name = "Arial" Size = 10.2 Charset = 0 Weight = 400 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty Height = 372 Left = 3120 TabIndex = 4 Top = 2160 Width = 4212 End Begin VB.TextBox txtNotiz DataSource = "AdodcAdressen" Height = 852 Left = 2280 ScrollBars = 2 'Vertikal TabIndex = 5 Top = 2640 Width = 5052 End Begin VB.TextBox txtTelefon BeginProperty Font Name = "Arial" Size = 10.2 Charset = 0 Weight = 400 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty Height = 372 Index = 0 Left = 3360 TabIndex = 7 Top = 3840 Width = 1212 End Begin VB.TextBox txtBemerkung BeginProperty Font Name = "Arial" Size = 10.2 Charset = 0 Weight = 400 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty Height = 372 Index = 0 Left = 4680 TabIndex = 8 Top = 3840 Width = 2652 End Begin VB.TextBox txtVorwahl BeginProperty Font Name = "Arial" Size = 10.2 Charset = 0 Weight = 400 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty Height = 372 Index = 0 Left = 2280 TabIndex = 6 Top = 3840 Width = 972 End Begin VB.TextBox txtTelefon BeginProperty Font Name = "Arial" Size = 10.2 Charset = 0 Weight = 400 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty Height = 372 Index = 1 Left = 3360 TabIndex = 10 Top = 4320 Width = 1212 End Begin VB.TextBox txtBemerkung BeginProperty Font Name = "Arial" Size = 10.2 Charset = 0 Weight = 400 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty Height = 372 Index = 1 Left = 4680 TabIndex = 11 Top = 4320 Width = 2652 End Begin VB.TextBox txtVorwahl BeginProperty Font Name = "Arial" Size = 10.2 Charset = 0 Weight = 400 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty Height = 372 Index = 1 Left = 2280 TabIndex = 9 Top = 4320 Width = 972 End Begin VB.TextBox txtTelefon BeginProperty Font Name = "Arial" Size = 10.2 Charset = 0 Weight = 400 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty Height = 372 Index = 2 Left = 3360 TabIndex = 13 Top = 4800 Width = 1212 End Begin VB.TextBox txtBemerkung BeginProperty Font Name = "Arial" Size = 10.2 Charset = 0 Weight = 400 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty Height = 372 Index = 2 Left = 4680 TabIndex = 14 Top = 4800 Width = 2652 End Begin VB.TextBox txtVorwahl BeginProperty Font Name = "Arial" Size = 10.2 Charset = 0 Weight = 400 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty Height = 372 Index = 2 Left = 2280 TabIndex = 12 Top = 4800 Width = 972 End Begin VB.CommandButton cmdNeu Caption = "&Neu" BeginProperty Font Name = "MS Sans Serif" Size = 7.8 Charset = 0 Weight = 700 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty Height = 372 Left = 2280 TabIndex = 15 Top = 5520 Width = 2172 End Begin VB.CommandButton cmdSpeichern Caption = "&Speichern" BeginProperty Font Name = "MS Sans Serif" Size = 7.8 Charset = 0 Weight = 700 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty Height = 372 Left = 4800 TabIndex = 16 Top = 5520 Width = 2172 End Begin VB.Label Label2 BackStyle = 0 'Transparent Caption = "Firma" BeginProperty Font Name = "Arial" Size = 10.2 Charset = 0 Weight = 700 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty Height = 372 Left = 480 TabIndex = 23 Top = 720 Width = 732 End Begin VB.Label Label3 BackStyle = 0 'Transparent Caption = "PLZ, Ort" BeginProperty Font Name = "Arial" Size = 10.2 Charset = 0 Weight = 700 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty Height = 372 Left = 480 TabIndex = 22 Top = 2160 Width = 1452 End Begin VB.Label Label4 BackStyle = 0 'Transparent Caption = "Straße" BeginProperty Font Name = "Arial" Size = 10.2 Charset = 0 Weight = 700 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty Height = 372 Left = 480 TabIndex = 21 Top = 1680 Width = 732 End Begin VB.Label Label5 BackStyle = 0 'Transparent Caption = "Vor-, Nachname" BeginProperty Font Name = "Arial" Size = 10.2 Charset = 0 Weight = 700 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty Height = 372 Left = 480 TabIndex = 20 Top = 1200 Width = 1572 End Begin VB.Label Label6 BackStyle = 0 'Transparent Caption = "Notiz" BeginProperty Font Name = "Arial" Size = 10.2 Charset = 0 Weight = 700 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty Height = 372 Left = 480 TabIndex = 19 Top = 2640 Width = 732 End Begin VB.Label Label7 BackStyle = 0 'Transparent Caption = "Telefonnummern" BeginProperty Font Name = "Arial" Size = 10.2 Charset = 0 Weight = 700 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty Height = 372 Left = 480 TabIndex = 18 Top = 3840 Width = 1452 End Begin VB.Label Label1 BackStyle = 0 'Transparent Caption = "Adresserfassung mit FlowFact.Application" BeginProperty Font Name = "Arial" Size = 12 Charset = 0 Weight = 700 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty Height = 372 Left = 360 TabIndex = 17 Top = 120 Width = 7452 End End Attribute VB_Name = "Form1" Attribute VB_GlobalNameSpace = False Attribute VB_Creatable = False Attribute VB_PredeclaredId = True Attribute VB_Exposed = False Option Explicit Dim g_oFFApp As Object Dim g_oUtil As cUtil Dim g_rsAdressen As Recordset Dim g_rsAdMkM As Recordset Dim g_rsMerkmale As Recordset Dim g_rsAktivitaet As Recordset Dim g_rsAktivArten As Recordset Dim g_rsAktMkM As Recordset Dim g_rsFeldArten As Recordset Dim g_rsAktDet As Recordset Dim g_strBenutzerMkMDSN As String Private Sub cmdNeu_Click() 'leert einfach alle Textboxen Dim contrl As Control For Each contrl In Me.Controls If TypeOf contrl Is TextBox Then contrl.Text = "" End If Next End Sub Private Sub cmdSpeichern_Click() 'hier wird der DS hinzugefügt und mit den Werten der Textboxen gefüllt 'Man beachte: ' Kennung -> hier keine Eingabemöglichkeit, wird also automatisch generiert ' DSN, Angelegt, ... -> werden automatisch generiert ' IDX_NAME und IDX_FIRMA -> werden automatisch generiert, hier kann wie in FlowFact ein '#' ' in das Feld Name oder Firma zur Beinflussung eingefügt werden ' Telefon -> hier die Sondersyntax aus Vorwahl & vbTab & Telefonnummer & Bemerkung & vbcrlf, ' dieser String wird beim Speichern in die einzelnen Nummer für die TAPI-Tabelle wieder zerlegt Dim strTempTelefon As String Dim I As Integer Dim vbookmark As Variant On Error GoTo ErrHandler '************************************************* 'A. Anlegen der Adresse '1. Telefonstring zusammenstellen For I = 0 To 2 strTempTelefon = strTempTelefon & txtVorwahl(I).Text & vbTab & txtTelefon(I).Text & vbTab & txtBemerkung(I).Text & vbCrLf Next '2. Adressdatensatz anlegen und Werte aus den Textboxen holen g_rsAdressen.AddNew g_rsAdressen("FIRMA") = txtFirma.Text g_rsAdressen("NAME") = txtName.Text g_rsAdressen("STRAßE") = txtStraße.Text g_rsAdressen("LAND_PLZ") = txtPLZ.Text g_rsAdressen("ORT") = txtOrt.Text g_rsAdressen("TELEFON") = strTempTelefon 'Datensatz - Lesezeichen zwischen speichern, da die Position nach Updatebatch geändert ist, wenn 'mehrere vorhanden sind vbookmark = g_rsAdressen.Bookmark '3. Updaten - die DSN wird hier beim Speichern generiert g_oFFApp.UpdateRecordSet g_rsAdressen '************************************************* '4. Anlegen der Merkmale zur Adresse g_rsAdressen.Bookmark = vbookmark 'a) Benutzer-Merkmal g_rsAdMkM.AddNew g_rsAdMkM("MKM_DSN") = g_strBenutzerMkMDSN g_rsAdMkM("LINK_DSN") = g_rsAdressen("DSN") 'b) neuangelegtes Merkmal für extern angelegte Adressen g_rsMerkmale.Filter = " Merkmal = 'ext. angel. Adresse'" g_rsAdMkM.AddNew g_rsAdMkM("MKM_DSN") = g_rsMerkmale("DSN") g_rsAdMkM("LINK_DSN") = g_rsAdressen("DSN") '************************************************* 'B. Anlegen der Aktivität '1. DS hinzufügen , Werte aus der (neuen) Aktivitätenart 'Neue Adresse' ' hier wird im Unterschied zu Oben die DSN gleich erstellt, so dass ohne das UpdateRecordset die DSN ' für Verknüpfungen verfügbar ist g_rsAktivitaet.AddNew g_rsAktivitaet("DSN") = g_oUtil.NewGUID g_rsAktivitaet("KENNUNG") = "" g_rsAktivitaet("AD_DSN") = g_rsAdressen("DSN") g_rsAktivitaet("ART_DSN") = g_rsAktivArten("DSN") g_rsAktivitaet("PRIORITÄT") = 1 g_rsAktivitaet("VORLAGE") = DateAdd("d", (Val(g_rsAktivArten("VORLAGE").Value)), Now) g_rsAktivitaet("BETRAG") = g_rsAktivArten("KOSTEN") g_rsAktivitaet("KM") = g_rsAktivArten("KM") g_rsAktivitaet("DATUM") = DateAdd("n", (Val(g_rsAktivArten("MINUTEN").Value)), Now) g_rsAktivitaet("DATUM_BIS") = Now g_rsAktivitaet("NOTIZ") = "Neue, über externes Programm angelegte Adresse, die evtl. noch nachbearbeitet werden muss!" '2. Anlegen der Merkmale zur Aktivität 'a) Benutzer-Merkmal g_rsAktMkM.AddNew g_rsAktMkM("MKM_DSN") = g_strBenutzerMkMDSN g_rsAktMkM("LINK_DSN") = g_rsAktivitaet("DSN") 'b) neuangelegtes Merkmal für extern angelegte Adressen g_rsMerkmale.Filter = " Merkmal = 'ext. angel. Aktivit.'" g_rsAktMkM.AddNew g_rsAktMkM("MKM_DSN") = g_rsMerkmale("DSN") g_rsAktMkM("LINK_DSN") = g_rsAktivitaet("DSN") '3. Anlegen von Aktivitäten Details (Sonstiges) ' a) für das externe Programm g_rsFeldArten.Filter = " Kürzel = 'ext. Programm'" g_rsAktDet.AddNew g_rsAktDet("AKT_DSN") = g_rsAktivitaet("DSN") g_rsAktDet("FLDART_DSN") = g_rsFeldArten("DSN") g_rsAktDet("EINGABE") = App.EXEName ' b) für die Testfeldart zur Demonstration der Aufteilung der intervalle g_rsFeldArten.Filter = " Kürzel = 'Testfeldart mit Intervall'" g_rsAktDet.AddNew g_rsAktDet("AKT_DSN") = g_rsAktivitaet("DSN") g_rsAktDet("FLDART_DSN") = g_rsFeldArten("DSN") g_rsAktDet("EINGABE") = " 10 bis 12 " ' Updaten der Recordsets g_oFFApp.UpdateRecordSet g_rsAktivitaet g_oFFApp.UpdateRecordSet g_rsAktMkM g_oFFApp.UpdateRecordSet g_rsAdMkM g_oFFApp.UpdateRecordSet g_rsAktDet Exit Sub ErrHandler: MsgBox Err.Number & " " & Err.Description, , Err.Source End Sub Private Sub Form_Load() 'Application - Object initialisieren Set g_oFFApp = GetObject("", "FlowFact.Application") Call Vorbereiten End Sub Private Sub Vorbereiten() ' hier werden die globalen Variablen initialisiert und ' zur Vorbereitung Merkmale, Feldarten und eine Aktivitätenart angelegt ' Achtung: diese werden in die Daten des momentan gestarteten FlowFacts eingetragen!!!! ' und wird nur zu Beispielzwecken vom Form_Load Ereignis gestartet If g_oFFApp.IsLoggedIn Then Set g_oUtil = New cUtil 'globale Variable für Benutzermerkmal füllen g_strBenutzerMkMDSN = g_oFFApp.CurrentUserRS("STD_MKM1") ' Testen ob die Merkmale "ext. angel. Adresse" und "ext. angel. Aktivit." existieren und wenn nicht 'dann anlegen Set g_rsMerkmale = g_oFFApp.GetRecordset(" Select * from MKM where Merkmal in ('ext. angel. Adresse' ,'ext. angel. Aktivit.' ) ") If g_rsMerkmale.RecordCount < 2 Then ' falls eines oder beide noch nicht angelegt sind 'Test für 1. Merkmal g_rsMerkmale.Filter = " Merkmal = 'ext. angel. Adresse'" If g_rsMerkmale.AbsolutePosition = adPosUnknown Then g_rsMerkmale.AddNew g_rsMerkmale("AD") = 1 g_rsMerkmale("AKTIV") = 1 g_rsMerkmale("NOTIZ") = "Merkmal aus dem Beispielprojekt zum externen Anlegen von Adressen und Aktivitäten" g_rsMerkmale("MERKMAL") = "ext. angel. Adresse" g_rsMerkmale("GRUPPE") = "Test externe Merkmale" End If 'Test für 2. Merkmal g_rsMerkmale.Filter = " Merkmal = 'ext. angel. Aktivit.'" If g_rsMerkmale.AbsolutePosition = adPosUnknown Then g_rsMerkmale.AddNew g_rsMerkmale("AKT") = 1 g_rsMerkmale("AKTIV") = 1 g_rsMerkmale("NOTIZ") = "Merkmal aus dem Beispielprojekt zum externen Anlegen von Adressen und Aktivitäten" g_rsMerkmale("MERKMAL") = "ext. angel. Aktivit." g_rsMerkmale("GRUPPE") = "Test externe Merkmale" End If g_rsMerkmale.Filter = adFilterNone ' jetzt die neuen Merkmale in die Datenbank schreiben g_oFFApp.UpdateRecordSet g_rsMerkmale End If 'Ende des Test, ob diese Merkmale schon angelegt sind 'Testen und evtl. neuanlegen der Aktivitätenart 'Neue Adresse' - auch nur für Flowfact-Administrator möglich Set g_rsAktivArten = g_oFFApp.GetRecordset(" Select * from aktivitätenarten where Name = 'Neue Adresse'") If g_rsAktivArten.AbsolutePosition = adPosUnknown Then g_rsAktivArten.AddNew g_rsAktivArten("NAME") = "Neue Adresse" g_rsAktivArten("KURZ") = "NAD" g_rsAktivArten("MINUTEN") = "-1" g_rsAktivArten("BACKCOLOR") = vbYellow g_rsAktivArten("FONTCOLOR") = vbRed g_rsAktivArten("NOTIZ") = " Aktivität aus dem Beispielprojekt zum externen Anlegen von Adressen und Aktivitäten" g_oFFApp.UpdateRecordSet g_rsAktivArten End If 'Ende des Test, ob diese Aktivitätenart schon angelegt ist 'Testen und evtl. neuanlegen der Feldarten für Aktivitätendetails Set g_rsFeldArten = g_oFFApp.GetRecordset(" Select * from fldart where Akt = 1 and Kürzel in( 'Testfeldart mit Intervall', 'ext. Programm') ") If g_rsFeldArten.RecordCount < 2 Then 'Test für erste Feldart g_rsFeldArten.Filter = " Kürzel = 'Testfeldart mit Intervall'" If g_rsFeldArten.AbsolutePosition = adPosUnknown Then g_rsFeldArten.AddNew g_rsFeldArten("KÜRZEL") = "Testfeldart mit Intervall" g_rsFeldArten("AKT") = 1 g_rsFeldArten("AKTIV") = 1 g_rsFeldArten("INTERVALL") = "1" g_rsFeldArten("TYP") = 2 g_rsFeldArten("NOTIZ") = "Feldart für Aktivitäten aus dem Beispielprojekt zum " _ & " externen Anlegen von Adressen und Aktivitäten, Typ nummerisch, mit Intervall" End If 'Test für zweite Feldart g_rsFeldArten.Filter = " Kürzel = 'ext. Programm'" If g_rsFeldArten.AbsolutePosition = adPosUnknown Then g_rsFeldArten.AddNew g_rsFeldArten("KÜRZEL") = "ext. Programm" g_rsFeldArten("AKT") = 1 g_rsFeldArten("AKTIV") = 1 g_rsFeldArten("INTERVALL") = 0 g_rsFeldArten("TYP") = 3 g_rsFeldArten("NOTIZ") = "Name der Anwendung, aus der die Aktivität erzeugt wurde; " _ & "Feldart für Aktivitäten aus dem Beispielprojekt zum externen Anlegen von Adressen und Aktivitäten, " End If g_rsFeldArten.Filter = adFilterNone g_oFFApp.UpdateRecordSet g_rsFeldArten End If 'Ende des Tests, ob Feldarten schon vorhanden 'leeres Adressenrecordset zum Anlegen der DS erstellen Set g_rsAdressen = g_oFFApp.GetRecordset("Select * from AD where 1=2 ") 'leeres Adressen-Merkmale-Recordset zum Anlegen erstellen Set g_rsAdMkM = g_oFFApp.GetRecordset("Select * from ADMKM where 1=2 ") 'leeres Aktivitäten-Recordset zum Anlegen der DS erstellen Set g_rsAktivitaet = g_oFFApp.GetRecordset("Select * from AKT where 1=2 ") 'leeres Aktivitäten-Merkmale-Recordset zum Anlegen erstellen Set g_rsAktMkM = g_oFFApp.GetRecordset("Select * from AKTMKM where 1=2 ") 'leeres Aktivitäten-Details-Recordset zum Anlegen erstellen - hier der Sonderfall für ...DET -Tabellen! Set g_rsAktDet = g_oFFApp.GetRecordset("Select AKTDET.* from AKT inner join AKTDET on AKT.DSN = AKTDET.AKT_DSN where 1=2 ") Else MsgBox "In FlowFact ist kein Benutzer angemeldet!" Unload Me End If End Sub