Private Sub BAendern_Click()

Dim str1 As String, str2 As String, oldpath As String

If Not IsNull(LMandanten) And LMandanten >= 0 Then

 str1 = ""
 While str1 = ""
 str1 = InputBox("Geben Sie bitte die Mandantenbezeichnung ein:", "Mandanten bearbeiten", DMax("[Bezeichnung]", "Mandanten", "[MANR]=" + Format(LMandanten)))
 Wend

 str2 = ""
 While str2 = ""
 str2 = InputBox("Geben Sie bitte den Datenpfad ein:", "Mandanten bearbeiten", DMax("[Data]", "Mandanten", "[MANR]=" + Format(LMandanten)))
 Wend
 
 Dim db1 As Database
 Dim rs1 As Recordset
 
 Set db1 = CurrentDb
 Set rs1 = db1.OpenRecordset("Mandanten")
 
 While Not rs1.EOF And rs1!MANR <> CLng(LMandanten)
  rs1.MoveNext
 Wend
 
 rs1.Edit
 oldpath = rs1!Data
 rs1!Bezeichnung = str1
 rs1!Data = str2
 rs1.Update
 rs1.Close
 
 LMandanten.Requery
 'If MsgBox("Wollen Sie die Daten kopieren", vbYesNo) = vbYes Then
 '
 ' If oldpath <> str2 Then
 '  FileCopy oldpath, str2
 ' End If
 'End If
End If

End Sub

Private Sub BLoeschen_Click()

If Not IsNull(LMandanten) And LMandanten >= 0 Then

If MsgBox("Sind Sie sicher, daß Sie diesen Mandanten löschen wollen ?", vbYesNo) = vbYes Then

  Dim db1 As Database
  Dim rs1 As Recordset
 
 Set db1 = CurrentDb
 Set rs1 = db1.OpenRecordset("Mandanten")
 
 While Not rs1.EOF And rs1!MANR <> CLng(LMandanten)
  rs1.MoveNext
 Wend
 
 rs1.Delete
 rs1.Close

 LMandanten.Requery
End If

End If

End Sub

Private Sub BNeu_Click()

Dim str1, str2 As String

 str1 = ""
 While str1 = ""
 str1 = InputBox("Geben Sie bitte die Mandantenbezeichnung ein:", "Mandanten bearbeiten")
 Wend
 
 str2 = ""
 While str2 = ""
 str2 = InputBox("Geben Sie bitte den Datenpfad ein:", "Mandanten bearbeiten", AppPath + "WGDATEN.ACCDB")
 Wend
 
 Dim db1 As Database
 Dim rs1 As Recordset
 
 Set db1 = CurrentDb
 Set rs1 = db1.OpenRecordset("Mandanten")

 rs1.AddNew
 rs1!Bezeichnung = str1
 rs1!Data = str2
 rs1.Update
 rs1.Close

 LMandanten.Requery
 
 If InStr(str2, "\") > 0 Then
  If MsgBox("Soll das Daten-Verzeichnis erstellt werden ?", vbYesNo) = vbYes Then
   ' Verzeichnis erstellen
   FileSystem.MkDir Mid(GetPathWithoutFilename(str2), 1, Len(GetPathWithoutFilename(str2)) - 1)
  End If
 End If
 
 If MsgBox("Wollen Sie eine neue Daten-Datei anlegen ?", vbYesNo) = vbYes Then
  FileCopy GetAppPath + "WGDATEN.ACCDB", str2
 End If

End Sub

Private Sub BOk_Click()

Weiter

End Sub




Private Sub BRücksichern_Click()


Dim datapath1
Dim apppath1
Dim archname
Dim archname1
Dim archname2
Dim cmdstr1

Dim sicherungspfad1 As String



If MsgBox("Sind Sie sicher, daß Sie sämtliche Daten von Diskette rücksichern wollen ? Alle aktuellen WG MASTER Daten auf der Festplatte gehen dabei verloren !!!", vbYesNo) = vbYes Then

        If IsNull(GetParameter("SICHERUNGSPFAD")) Then
          SetParameter "SICHERUNGSPFAD", "A:\"
        End If
        
        sicherungspfad1 = GetParameter("SICHERUNGSPFAD")
        
        str1 = InputBox("Bitte geben Sie den Pfad ein, von wo WG MASTER rücksichern soll: ", "Sicherungspfad eingeben", sicherungspfad1)
        If Not IsNull(str1) And str1 <> "" Then
         sicherungspfad1 = str1
          SetParameter "SICHERUNGSPFAD", sicherungspfad1
        End If
        
        archname = "wgdata.arj"
        archname2 = sicherungspfad1 + archname
        
        datapath1 = GetDataPath
        apppath1 = GetAppPath
        archname1 = GetPathWithoutFilename(GetDataPath) + archname
        
        On Error GoTo Error1
        
        If Not IsNull(datapath1) And Not IsNull(apppath1) Then
        
         
        MsgBox ("Bitte Medium in Laufwerk " + sicherungspfad1 + " einlegen (Diskette, ZIP-Medium)")
         
         If Fileexist(Format(archname2)) = False Then
          MsgBox "FEHLER: Sicherungsdatei nicht gefunden !", vbCritical
          Exit Sub
         Else
          If Fileexist(Format(archname1)) Then FileSystem.Kill (archname1)
          DoCmd.Hourglass True
          FileCopy archname2, archname1
          If Fileexist(Format(datapath1)) Then FileSystem.Kill (datapath1)
        
          FileSystem.ChDrive Left(GetDataPath, 1)
          FileSystem.ChDir GetPathWithoutFilename(GetDataPath)
          cmdstr1 = apppath1 + "arj.exe x -y " + archname1 + " " + GetPathWithoutFilename(GetDataPath) + " " + "WGDATEN.ACCDB"
          'MsgBox (cmdstr1)
          Shell cmdstr1, vbNormalFocus
          FileSystem.ChDir apppath1
         
          DoCmd.Hourglass False
          MsgBox ("Daten erfolgreich rückgesichert")
         End If
         
        End If
        
        Exit Sub

End If

Error1:
 MsgBox "FEHLER: Datenträger nicht bereit!", vbCritical
 DoCmd.Hourglass False
 Exit Sub



End Sub

Private Sub BSichern_Click()

Dim datapath1
Dim apppath1
Dim archname
Dim archname1
Dim archname2
Dim cmdstr1
Dim sicherungspfad1 As String
Dim str1

If IsNull(GetParameter("SICHERUNGSPFAD")) Then
  SetParameter "SICHERUNGSPFAD", "A:\"
End If

sicherungspfad1 = GetParameter("SICHERUNGSPFAD")

str1 = InputBox("Bitte geben Sie den Pfad ein, wohin WG MASTER sichern soll: ", "Sicherungspfad eingeben", sicherungspfad1)
If Not IsNull(str1) And str1 <> "" Then
 sicherungspfad1 = str1
  SetParameter "SICHERUNGSPFAD", sicherungspfad1
End If


archname = "wgdata.arj"
archname2 = sicherungspfad1 + archname

datapath1 = GetDataPath
apppath1 = GetAppPath
archname1 = GetPathWithoutFilename(GetDataPath) + archname

'MsgBox (datapath1)
'MsgBox (apppath1)
'MsgBox (archname1)
'MsgBox (archname2)

On Error GoTo Error1

If Not IsNull(datapath1) And Not IsNull(apppath1) Then
 DoCmd.Hourglass True
 
 
 If Fileexist(Format(archname1)) = True Then FileSystem.Kill (archname1)
 
 FileSystem.ChDrive Left(GetDataPath, 1)
 FileSystem.ChDir GetPathWithoutFilename(GetDataPath)
 cmdstr1 = apppath1 + "arj.exe a " + archname1 + " " + "WGDATEN.ACCDB"
 'MsgBox (cmdstr1)
 Shell cmdstr1, vbNormalFocus
 FileSystem.ChDir apppath1
 
 MsgBox ("Bitte Medium in Laufwerk " + sicherungspfad1 + " einlegen (Diskette, ZIP-Medium)")

 If Fileexist(Format(archname2)) Then FileSystem.Kill (archname2)
 
 FileCopy archname1, archname2
 FileSystem.Kill archname1
 If Fileexist(Format(archname1)) Then FileSystem.Kill (archname1)
 
 DoCmd.Hourglass False
 MsgBox ("Daten erfolgreich gesichert")
End If

Exit Sub

Error1:
 MsgBox "FEHLER: Datenträger nicht bereit!", vbCritical
 DoCmd.Hourglass False
 Exit Sub




End Sub

Private Sub Form_Close()

'docmd.quit

End Sub

Private Sub Form_Open(Cancel As Integer)

LMandanten.SetFocus
If Not IsNull(LMandanten.ItemData(0)) Then LMandanten = LMandanten.ItemData(0)

End Sub

Private Sub LMandanten_DblClick(Cancel As Integer)

Weiter

End Sub

Sub Weiter()

If Not IsNull(LMandanten) And LMandanten >= 0 Then

  Dim manr1 As Long
  Dim Data As String
  Dim datapath As String
 
  DoCmd.Hourglass True
 
  manr1 = LMandanten
 
  Data = DMax("[Data]", "Mandanten", "MANR=" + Format(manr1))
 
  'MsgBox (data)
 
  If FileSystem.FileLen(Data) > 0 Then
 
    datapath = GetPathWithoutFilename(Data)
   
  'MsgBox ("1")
    
    SetLinkTablePath "", Data
  
  
  
  
    'Check runtime or full version
    If UCase(Right(CurrentDb.Name, 1)) = "B" Then 'MDB or ACCDB
      
      
      If manr1 <> GetLastMANR() Then
          SetLastMANR (manr1)
          SetReportControlProperty1 "", "BLogo", acImage, "Picture", datapath + "LOGO.BMP"
      End If
      
      
      'Vollupdate prüfen
  'MsgBox ("2")
      DoCmd.OpenForm "MHauptmenü", acDesign
      
      If Forms("MHauptmenü").XVersion2.Caption = "Vollupdate" Then
        '1. Logo aktualisieren
        
  'MsgBox ("3")
        SetReportControlProperty1 "", "BLogo", acImage, "Picture", datapath + "LOGO.BMP"
      
      
       '2. SQL Statements ausführen
        Dim db1 As Database
        Dim cnt1 As Container
        Dim doc1 As Document
              
         ' Current Database for SQL Statements
        Dim db2 As Database
        Dim rs1 As Recordset
        
        
        Set db2 = Application.DBEngine.Workspaces(0).OpenDatabase(GetDataPath())
        
         Set db1 = CurrentDb
          For Each cnt1 In db1.Containers
           
           If cnt1.Name = "Tables" Then
            For Each doc1 In cnt1.Documents
             If doc1.Name = "Update_SQLStatements" Then
              Set rs1 = db1.OpenRecordset("Update_SQLStatements")
              While Not rs1.EOF
               'If MsgBox(rs1!Beschreibung + " ?", vbYesNo) = vbYes Then
                On Error Resume Next
                db2.Execute (rs1!SQLStatement)
               'End If
               rs1.MoveNext
              Wend
              rs1.Close
              db1.Execute ("DROP Table Update_SQLStatements")
             End If
            Next doc1
           End If
            
         Next cnt1
         
       '3. Übernahmeformular - Kommunikationsparameter einstellen
       'DoCmd.OpenForm "FÜbernahme", acDesign
    
       'MsgBox (GetParameter("WAAGEPORTSETTINGS"))
       'MsgBox (CLng(GetParameter("WAAGEPORT")))
       'MsgBox (CLng(GetParameter("STEUERUNGPORT")))
       
       'Forms!FÜbernahme!XComm.Settings = GetParameter("WAAGEPORTSETTINGS")
       'Forms!FÜbernahme!XComm.CommPort = CLng(GetParameter("WAAGEPORT"))
       'Forms!FÜbernahme!XCommSteuerung.CommPort = CLng(GetParameter("STEUERUNGPORT"))
    
       'DoCmd.Save
       'DoCmd.Close
         
       '4. Vollupdate Label entfernen
       Forms("MHauptmenü").XVersion2.Caption = ""
       DoCmd.Save
    
      End If
      
      DoCmd.Close
    
    End If
    
    DoCmd.Hourglass False
    DoCmd.OpenForm "MHauptmenü"
     
  End If



End If

End Sub

Function SetReportControlProperty1(reportname As String, ControlName As String, Controltype As Integer, PropertyName As String, PropertyValue As Variant)
' Sets the given property of the given control in the given form to the given value
' If Formname="" then all forms
' If Controlname="" then all controls

Dim sec1 As Section
Dim ctl1 As Control
Dim i As Variant

If reportname = "" Or IsNull(reportname) Then
'All Reports
 Dim db1 As Database
 Dim cnt1 As Container
 Dim doc1 As Document

 Set db1 = CurrentDb
  For Each cnt1 In db1.Containers
   If cnt1.Name = "Reports" Then
    For Each doc1 In cnt1.Documents
     DoCmd.OpenReport doc1.Name, acViewDesign
     
     On Error Resume Next
     'look into all sections
     For i = 0 To 8
      'If Reports(doc1.Name).Section(i).Visible = True Then
        Reports(doc1.Name).Controls(ControlName).Properties(PropertyName) = PropertyValue
        'Set sec1 = Reports(doc1.Name).Section(i)
        'For Each ctl1 In sec1.Controls
         'If ctl1.Name = ControlName Or ControlName = "" Or IsNull(ControlName) Then
          'If Controltype = ctl1.Controltype Or Controltype = -1 Then
           'On Error Resume Next
           'ctl1.Properties(PropertyName) = PropertyValue
          'End If
         'End If
        'Next ctl1
      'End If
     Next i
     DoCmd.Save
     DoCmd.Close
    Next doc1
   End If
 Next cnt1

Else
 DoCmd.OpenReport reportname, acViewDesign
 For i = 0 To 8
  Set sec1 = Reports(reportname).Section(i)
  For Each ctl1 In sec1.Controls
   If ctl1.Name = ControlName Or ControlName = "" Or IsNull(ControlName) Then
    On Error Resume Next
    ctl1.Properties(PropertyName) = PropertyValue
   End If
  Next ctl1
 Next i
 DoCmd.Save
 DoCmd.Close
End If





End Function