Option Compare Database
Option Explicit

Private Sub Befehl14_Click()

Dim filename As String
Dim defaultfilename As String
Dim str1

If IsNull(GetParameter("UPDATEPATH")) Then
  SetParameter "UPDATEPATH", "A:\WGUPDATE.ACCDB"
End If

defaultfilename = GetParameter("UPDATEPATH")

'defaultfilename = "D:\PROJEKT\CHRIS\WGMASTER\WGUPDATE.ACCDB"

filename = InputBox("Geben Sie Bitte den Dateinamen ein: ", "Update einspielen", defaultfilename)

If Not IsNull(filename) And filename <> "" Then

SetParameter "UPDATEPATH", filename

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())

 On Error GoTo err1
 Set db1 = Application.DBEngine.Workspaces(0).OpenDatabase(filename)
 On Error GoTo 0
  For Each cnt1 In db1.Containers
   If cnt1.Name = "Forms" Then
    For Each doc1 In cnt1.Documents
     If MsgBox(doc1.Name + " importieren ?", vbYesNo) = vbYes Then
      On Error Resume Next
      'close open forms
      If Not IsNull(Form(doc1.Name)) Then
       DoCmd.Close acForm, doc1.Name
      End If
      
      DoCmd.DeleteObject acForm, doc1.Name
      DoCmd.TransferDatabase acImport, "Microsoft Access", filename, acForm, doc1.Name, doc1.Name
     End If
    Next doc1
   End If
   If cnt1.Name = "Reports" Then
    For Each doc1 In cnt1.Documents
     If MsgBox(doc1.Name + " importieren ?", vbYesNo) = vbYes Then
      On Error Resume Next
      DoCmd.DeleteObject acReport, doc1.Name
      DoCmd.TransferDatabase acImport, "Microsoft Access", filename, acReport, doc1.Name, doc1.Name
     End If
    Next doc1
   End If
   
   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
        db2.Execute (rs1!SQLStatement)
       End If
       rs1.MoveNext
      Wend
      rs1.Close
     End If
    Next doc1
   End If

   If cnt1.Name = "Modules" Then
    For Each doc1 In cnt1.Documents
     If MsgBox(doc1.Name + " importieren ?", vbYesNo) = vbYes Then
      On Error Resume Next
      DoCmd.DeleteObject acModule, doc1.Name
      DoCmd.TransferDatabase acImport, "Microsoft Access", filename, acModule, doc1.Name, doc1.Name
     End If
    Next doc1
   End If


 Next cnt1

End If

Exit Sub

err1:

MsgBox "FEHLER: Update-Datei nicht gefunden !", vbCritical

End Sub

Private Sub Befehl15_Click()

DoCmd.OpenForm "MImport"

End Sub

Private Sub Befehl16_Click()

DoCmd.OpenForm "MExport"

End Sub



Private Sub BLogoAkt_Click()

Dim datapath As String
Dim Data As String

Data = DMax("[Data]", "Mandanten", "MANR=" + Format(Forms!MMandantenauswahl!LMandanten))
datapath = GetPathWithoutFilename(Data)
If FileSystem.FileLen(datapath + "LOGO.BMP") > 0 Then
 SetReportControlProperty1 "", "BLogo", acImage, "Picture", datapath + "LOGO.BMP"
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
     If doc1.Name <> "BAuszahlungsvariante" Then
        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
     End If
    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

Private Sub BOk_Click()

If LWaagentyp <> "L246" Then
 DoCmd.OpenForm "FÜbernahme", acDesign
 Forms!FÜbernahme!XComm.Settings = TSettings
 Forms!FÜbernahme!XComm.CommPort = LPort
 Forms!FÜbernahme!XCommSteuerung.CommPort = LPortSteuerung
 DoCmd.Save
 DoCmd.Close
End If

SetParameter "WAAGENTYP", LWaagentyp
SetParameter "STEUERUNGTYP", LSteuerungtyp
SetParameter "WAAGEPORT", LPort
SetParameter "STEUERUNGPORT", LPortSteuerung
SetParameter "WAAGEPORTSETTINGS", TSettings


SetParameter "WAAGENMONITORLIMIT", TWaagenmonitorLimit

If OWaagenmonitor Then
 SetParameter "WAAGENMONITOR", "1"
Else
 SetParameter "WAAGENMONITOR", "0"
End If


DoCmd.Close

End Sub

Private Sub Form_Close()

SetParameter "WAAGENTYP", LWaagentyp

If LSteuerungtyp = "PARALLEL" Then
 SetParameter "STEUERUNGPORT", LLPT
End If

If LSteuerungtyp = "SERIELL" Then
 SetParameter "STEUERUNGPORT", LPortSteuerung
End If

If LSteuerungtyp = "EXTERN" Then
 SetParameter "STEUERUNGEXTERN", TExtern
End If

End Sub

Private Sub Form_Open(Cancel As Integer)


'DoCmd.OpenForm "FÜbernahme", acDesign

'TSettings = Forms!FÜbernahme!XComm.Settings
'LPort = Forms!FÜbernahme!XComm.CommPort
'LPortSteuerung = Forms!FÜbernahme!XCommSteuerung.CommPort
TSettings = GetParameter("WAAGEPORTSETTINGS")
LPort = GetParameter("WAAGEPORT")
LPortSteuerung = GetParameter("STEUERUNGPORT")

'DoCmd.Save
'DoCmd.Close

LWaagentyp = GetParameter("WAAGENTYP")
LSteuerungtyp = GetParameter("STEUERUNGTYP")

Dim host As String
Dim tcpport As Long

If IsNull(GetParameter("WAAGEHOST")) Then
 SetParameter "WAAGEHOST", "10.0.0.80"
 SetParameter "WAAGETCPPORT", "1234"
End If

host = GetParameter("WAAGEHOST")
tcpport = GetParameter("WAAGETCPPORT")



If LSteuerungtyp = "SERIELL" Then
 LPortSteuerung.Visible = True
 XPortSteuerung.Visible = True
 LPortSteuerung = GetParameter("STEUERUNGPORT")
Else
 LPortSteuerung.Visible = False
 XPortSteuerung.Visible = False
End If

If LSteuerungtyp = "PARALLEL" Then
 LLPT.Visible = True
 XLPT.Visible = True
 LLPT = GetParameter("STEUERUNGPORT")
Else
 LLPT.Visible = False
 XLPT.Visible = False
End If

If LSteuerungtyp = "EXTERN" Then
 TExtern.Visible = True
 TExtern = GetParameter("STEUERUNGEXTERN")
Else
 TExtern.Visible = False
End If

TWaagenmonitorLimit = GetParameter("WAAGENMONITORLIMIT")
If GetParameter("WAAGENMONITOR") = "1" Then
 OWaagenmonitor = True
Else
 OWaagenmonitor = False
End If

End Sub

Private Sub LSteuerungtyp_Click()

If LSteuerungtyp = "SERIELL" Then
 LPortSteuerung.Visible = True
 XPortSteuerung.Visible = True
Else
 LPortSteuerung.Visible = False
 XPortSteuerung.Visible = False
End If

If LSteuerungtyp = "PARALLEL" Then
 LLPT.Visible = True
 XLPT.Visible = True
Else
 LLPT.Visible = False
 XLPT.Visible = False
End If

If LSteuerungtyp = "EXTERN" Then
 TExtern.Visible = True
Else
 TExtern.Visible = False
End If

End Sub