'Globals for data exchange with export functions

Dim mgnr1 As String
Dim nachname1 As String
Dim vorname1 As String
Dim strasse1 As String
Dim plz1 As String
Dim ort1 As String

Dim bhkontonr1 As String
Dim blz1 As String
Dim bankname1 As String
Dim bankname2 As String
Dim kontonr1 As String
Dim IBAN As String
Dim BIC As String

Dim netto1 As Double
Dim mwst1 As Double
Dim mwstprozent1 As Double
Dim brutto1 As Double

Dim sum_netto1 As Double
Dim sum_mwst1 As Double
Dim sum_brutto1 As Double

Dim noIBANorBIC As String

'Globals for bmd export

Dim Buchungsdatum1 As Date
Dim Gegenkonto1 As String
Dim Belegnummer1 As String
Dim Belegdatum1 As Date
Dim Kostenstelle1 As String
Dim Steuercode1 As String
Dim Buchungscode1 As String
Dim Zahlungsziel1 As String
Dim Skonto1 As String
Dim Skonto2 As String
Dim Vertreter1 As String
Dim Provision1 As String
Dim Benutzernummer1 As String
Dim Belegsymbol1  As String

Dim BruttoKonto As String
Dim NettoKonto As String
Dim MwStKonto As String


Private Sub BOk_Click()

If Fileexists(TExportDatei) Then
 If MsgBox("Datei " + TExportDatei + " existiert bereits ! Überschreiben", vbYesNo) = vbYes Then
  ExportAuszahlung TExportDatei, LAuszahlungsAnteil
  'DoCmd.Close
 End If
Else
 If Not IsNull(TExportDatei) And TExportDatei <> "" Then
  ExportAuszahlung TExportDatei, LAuszahlungsAnteil
  'DoCmd.Close
 Else
  MsgBox "Bitte geben Sie eine Exportdatei an !", vbCritical
 End If
End If

End Sub


Private Sub Form_Close()

If Not IsNull(TExportDatei) And TExportDatei <> "" Then
 Select Case OExportOption
  Case 1: ' CDF
          SetParameter "AUSZAHLUNGEXPORTDATEI1", TExportDatei
  Case 2: ' BMD: PERSONENKONTEN
          SetParameter "AUSZAHLUNGEXPORTDATEI2", TExportDatei
  Case 3: ' BMD: SACHKONTEN
          SetParameter "AUSZAHLUNGEXPORTDATEI3", TExportDatei
  Case 4: ' DBF
          SetParameter "AUSZAHLUNGEXPORTDATEI4", TExportDatei
  Case 5: ' DBF
          SetParameter "AUSZAHLUNGEXPORTDATEI5", TExportDatei
 End Select
 
End If

SetParameter "AUSZAHLUNGEXPORTDEFAULT", OExportOption

End Sub

Private Sub Form_Open(Cancel As Integer)

If IsNull(GetParameter("AUSZAHLUNGEXPORTDEFAULT")) Then
 SetParameter "AUSZAHLUNGEXPORTDEFAULT", 1
End If

OExportOption = GetParameter("AUSZAHLUNGEXPORTDEFAULT")

Select Case OExportOption

Case 1: 'CDF
      If IsNull(GetParameter("AUSZAHLUNGEXPORTDATEI1")) Then
       SetParameter "AUSZAHLUNGEXPORTDATEI1", "C:\AUSZAHLUNG.TXT"
      End If
      TExportDatei = GetParameter("AUSZAHLUNGEXPORTDATEI1")
Case 2: 'BMD PERSONENKONTO
      If IsNull(GetParameter("AUSZAHLUNGEXPORTDATEI2")) Then
       SetParameter "AUSZAHLUNGEXPORTDATEI2", "C:\PEKO.BMD"
      End If
      TExportDatei = GetParameter("AUSZAHLUNGEXPORTDATEI2")
Case 3: 'BMD SACHKONTO
      If IsNull(GetParameter("AUSZAHLUNGEXPORTDATEI3")) Then
       SetParameter "AUSZAHLUNGEXPORTDATEI3", "C:\SAKO.BMD"
      End If
      TExportDatei = GetParameter("AUSZAHLUNGEXPORTDATEI3")
      
Case 4: 'DBF
      If IsNull(GetParameter("AUSZAHLUNGEXPORTDATEI4")) Then
       SetParameter "AUSZAHLUNGEXPORTDATEI4", "C:\AUSZAHLG.DBF"
      End If
      TExportDatei = GetParameter("AUSZAHLUNGEXPORTDATEI4")

Case 5: 'ELBA
      If IsNull(GetParameter("AUSZAHLUNGEXPORTDATEI5")) Then
       SetParameter "AUSZAHLUNGEXPORTDATEI5", "C:\AUSZAHLG.ELBA"
      End If
      TExportDatei = GetParameter("AUSZAHLUNGEXPORTDATEI5")

End Select

LAuszahlungsAnteil = 0


End Sub





Sub ExportAuszahlung(filename1 As String, AuszahlungsAnteilModus As Long)


Dim db1 As Database
Dim rs_auszahlung As Recordset
Dim query1 As String
Dim Lesejahr1 As Long
Dim rcounter As Long
Dim line1 As String
Dim filenum



DoCmd.Hourglass True

Lesejahr1 = Forms!FAuszahlung!TLesejahr
query1 = "SELECT Nachname, Vorname, TMitglieder.Straße, TMitglieder.PLZ, TMitglieder.Ort, TMitglieder.MGNR, BHKontonummer, TMitglieder.IBAN, TMitglieder.BIC, Sum(TLieferungen.BTeilzahlung1) AS SBTeilzahlung1, Sum(TLieferungen.BTeilzahlung2) AS SBTeilzahlung2, Sum(TLieferungen.BTeilzahlung3) AS SBTeilzahlung3, Sum(TLieferungen.BTeilzahlung4) AS SBTeilzahlung4, Sum(TLieferungen.BTeilzahlung5) AS SBTeilzahlung5, Sum(TLieferungen.BEndauszahlung) AS SBEndauszahlung, Name1, Name2, TMitglieder.BLZ as BLZ, KontoNr, Sum(TLieferungen.BProbeauszahlung) AS SBProbeauszahlung, TMitglieder.Buchführend FROM TBanken RIGHT JOIN (TMitglieder INNER JOIN TLieferungen ON TMitglieder.MGNR = TLieferungen.MGNR) ON TBanken.BLZ = TMitglieder.BLZ "
query1 = query1 + "GROUP BY TMitglieder.Nachname, TMitglieder.Vorname, TMitglieder.Straße, TMitglieder.PLZ, TMitglieder.Ort, TMitglieder.MGNR, BHKontonummer, Name1, Name2, TMitglieder.BLZ, TMitglieder.KontoNr, TMitglieder.IBAN, TMitglieder.BIC, TMitglieder.Buchführend, Year([Datum]) HAVING (((Year([Datum]))=" + Format(Lesejahr1) + "))"

Set db1 = CurrentDb
Set rs_auszahlung = db1.OpenRecordset(query1)

rcounter = 0
sum_netto1 = 0
sum_mwst1 = 0
sum_brutto1 = 0

filenum = FreeFile

Open filename1 For Output As filenum

 Select Case OExportOption
 
 Case 1: ' CDF
           PrintAuszahlungCDFHeader (filenum)
 Case 2: ' BMD
           PrintAuszahlungBMDHeader (filenum)
 Case 3: ' BMD SAKO
           PrintAuszahlungBMDSakoHeader (filenum)
 Case 4: ' DBF
           ' the file access is not used
           Close filenum
           FileSystem.Kill (filename1)
           PrintAuszahlungDBFHeader (filenum)
           Open filename1 For Input As filenum
 Case 5: ' CDF
           PrintAuszahlungElbaHeader (filenum)
 End Select

noIBANorBIC = ""
While Not rs_auszahlung.EOF
 
 mgnr1 = Format(rs_auszahlung![MGNR])
 If IsNull(rs_auszahlung!Nachname) Then nachname1 = "" Else nachname1 = rs_auszahlung!Nachname
 If IsNull(rs_auszahlung!Vorname) Then vorname1 = "" Else vorname1 = rs_auszahlung!Vorname
 If IsNull(rs_auszahlung![Straße]) Then strasse1 = "" Else strasse1 = rs_auszahlung![Straße]
 If IsNull(rs_auszahlung![PLZ]) Then plz1 = "" Else plz1 = rs_auszahlung!PLZ
 If IsNull(rs_auszahlung!Ort) Then ort1 = "" Else ort1 = rs_auszahlung!Ort
 'If IsNull(rs_auszahlung!BLZ) Then blz1 = "" Else blz1 = rs_auszahlung!BLZ
 'If IsNull(rs_auszahlung!KontoNr) Then kontonr1 = "" Else kontonr1 = rs_auszahlung!KontoNr
 If IsNull(rs_auszahlung!BIC) Then
  BIC = ""
  noIBANorBIC = noIBANorBIC + Format(rs_auszahlung!MGNR) + ", "
 Else
  BIC = rs_auszahlung!BIC
 End If
 If IsNull(rs_auszahlung!IBAN) Then
  IBAN = ""
  If Not IsNull(rs_auszahlung!BIC) Then
   noIBANorBIC = noIBANorBIC + Format(rs_auszahlung!MGNR) + ", "
  End If
 Else
  IBAN = rs_auszahlung!IBAN
 End If
 If IsNull(rs_auszahlung!BHKontonummer) Then bhkontonr1 = "" Else bhkontonr1 = rs_auszahlung!BHKontonummer
 If IsNull(rs_auszahlung!Name1) Then bankname1 = "" Else bankname1 = rs_auszahlung!Name1
 If IsNull(rs_auszahlung!Name2) Then bankname2 = "" Else bankname2 = rs_auszahlung!Name2
 
 ' calculate netto1
 
 Select Case Forms!FAuszahlung!TZahlungNr
 
 Case 1: netto1 = rs_auszahlung!SBTeilzahlung1
 Case 2: netto1 = rs_auszahlung!SBTeilzahlung2
 Case 3: netto1 = rs_auszahlung!SBTeilzahlung3
 Case 4: netto1 = rs_auszahlung!SBTeilzahlung4
 Case 5: netto1 = rs_auszahlung!SBTeilzahlung5
 Case 6: netto1 = rs_auszahlung!SBEndauszahlung - rs_auszahlung!SBTeilzahlung5 - rs_auszahlung!SBTeilzahlung4 - rs_auszahlung!SBTeilzahlung3 - rs_auszahlung!SBTeilzahlung2 - rs_auszahlung!SBTeilzahlung1
 Case 7: netto1 = rs_auszahlung!SBProbeauszahlung
 End Select
 
 'Anteil % anwenden
 Select Case AuszahlungsAnteilModus
 Case 0: '100%
  netto1 = Runden(netto1, 2)
 Case 1: '50% Teilzahlung
  netto1 = Runden(netto1 * 50 / 100, 2)
 Case 2: '50% Restzahlung
  netto1 = Runden(netto1, 2) - Runden(netto1 * 50 / 100, 2)
 Case 3: '75% Teilzahlung
  netto1 = Runden(netto1 * 75 / 100, 2)
 Case 4: '25% Restzahlung
  netto1 = Runden(netto1, 2) - Runden(netto1 * 75 / 100, 2)

 End Select
 
 'calculate mwst1
 If rs_auszahlung![Buchführend] Then
  mwstprozent1 = GetParameter("MWST2")
 Else
  mwstprozent1 = GetParameter("MWST1")
 End If
 mwst1 = Runden(netto1 * mwstprozent1 / 100, 2)
 'mwst1 = netto1 * mwstprozent1 / 100
 
 'calculate brutto1
 brutto1 = netto1 + mwst1
 
 'calculate sums
 sum_brutto1 = sum_brutto1 + brutto1
 sum_netto1 = sum_netto1 + netto1
 sum_mwst1 = sum_mwst1 + mwst1
 
 line1 = rs_auszahlung![MGNR]
 
 ' output to file
 
 Select Case OExportOption
 
 Case 1: ' CDF
           PrintAuszahlungCDFData (filenum)
 Case 2: ' BMD
           PrintAuszahlungBMDData (filenum)
 Case 3: ' BMD SAKO
           PrintAuszahlungBMDSakoData (filenum)
 Case 4: ' DBF
           PrintAuszahlungDBFData (filenum)
 Case 5: ' Elba
           PrintAuszahlungElbaData (filenum)
 End Select
 
 rs_auszahlung.MoveNext
 rcounter = rcounter + 1
Wend

rs_auszahlung.Close

DoCmd.Hourglass False

MsgBox (Format(rcounter) + " Auszahlungen erfolgreich exportiert ! Summe Netto: " + Format(sum_netto1) + " Summe MwSt: " + Format(sum_mwst1) + " Summe Brutto: " + Format(sum_brutto1))

If noIBANorBIC <> "" Then
 MsgBox ("Folgende Mitglieder (MGNR) haben fehlende IBAN/BIC Daten:" + Chr(13) + Chr(10) + noIBANorBIC)
End If

Select Case OExportOption
 
 Case 1: ' CDF
           PrintAuszahlungCDFFooter (filenum)
 Case 2: ' BMD
           PrintAuszahlungBMDFooter (filenum)
 Case 3: ' BMD
           PrintAuszahlungBMDSakoFooter (filenum)
 Case 4: ' DBF
           PrintAuszahlungDBFFooter (filenum)
 Case 5: ' Elba
           PrintAuszahlungElbaFooter (filenum)

End Select

Close filenum

End Sub

Private Sub OExportOption_Click()

Select Case OExportOption

Case 1: 'CDF
      If IsNull(GetParameter("AUSZAHLUNGEXPORTDATEI1")) Then
       SetParameter "AUSZAHLUNGEXPORTDATEI1", "C:\AUSZAHLUNG.TXT"
      End If
      TExportDatei = GetParameter("AUSZAHLUNGEXPORTDATEI1")
Case 2: 'BMD
      If IsNull(GetParameter("AUSZAHLUNGEXPORTDATEI2")) Then
       SetParameter "AUSZAHLUNGEXPORTDATEI2", "C:\PEKO.BMD"
      End If
      TExportDatei = GetParameter("AUSZAHLUNGEXPORTDATEI2")
Case 3: 'BMD SACHKONTO
      If IsNull(GetParameter("AUSZAHLUNGEXPORTDATEI3")) Then
       SetParameter "AUSZAHLUNGEXPORTDATEI3", "C:\SAKO.BMD"
      End If
      TExportDatei = GetParameter("AUSZAHLUNGEXPORTDATEI3")
      
Case 4: 'DBF
      If IsNull(GetParameter("AUSZAHLUNGEXPORTDATEI4")) Then
       SetParameter "AUSZAHLUNGEXPORTDATEI4", "C:\AUSZAHLG.DBF"
      End If
      TExportDatei = GetParameter("AUSZAHLUNGEXPORTDATEI4")

Case 5: 'ELBA
      If IsNull(GetParameter("AUSZAHLUNGEXPORTDATEI5")) Then
       SetParameter "AUSZAHLUNGEXPORTDATEI5", "C:\AUSZAHLG.ELBA"
      End If
      TExportDatei = GetParameter("AUSZAHLUNGEXPORTDATEI5")


End Select


End Sub





' ******************************************************************************
' THE EXPORT ROUTINES
' ******************************************************************************


' ******************************************************************************
' CDF EXPORT
' ******************************************************************************


Sub PrintAuszahlungCDFData(filenumber)

Dim s1 As String
s1 = ";"

Print #filenumber, mgnr1 + s1 + nachname1 + s1 + vorname1 + s1 + strasse1 + s1 + plz1 + s1 + ort1 + s1 + IBAN + s1 + BIC + s1 + bankname1 + s1 + bankname2 + s1 + bhkontonr1 + s1 + Format(netto1, "#,##0.00") + s1 + Format(mwstprozent1) + s1 + Format(mwst1, "#,##0.00") + s1 + Format(brutto1, "#,##0.00")

End Sub


Sub PrintAuszahlungCDFHeader(filenumber)

Dim line1 As String
Dim s1 As String
s1 = ";"
line1 = ""

Print #filenumber, "AUSZAHLUNGSLISTE"
Print #filenumber, "für Lesejahr " + Format(Forms!FAuszahlung!TLesejahr)

Select Case Forms!FAuszahlung!TZahlungNr
 Case 1: Print #filenumber, "1. Teilzahlung"
 Case 2: Print #filenumber, "2. Teilzahlung"
 Case 3: Print #filenumber, "3. Teilzahlung"
 Case 4: Print #filenumber, "4. Teilzahlung"
 Case 5:
         If IsNull(GetParameter("FREIERAUSZAHLUNGSTITEL")) Then
          Print #filenumber, ""
         Else
          Print #filenumber, GetParameter("FREIERAUSZAHLUNGSTITEL")
         End If
 Case 6: Print #filenumber, "Endauszahlung"
 Case 7: Print #filenumber, "Probeauszahlung"
End Select
 
Print #filenumber, Forms!FAuszahlung!TTitel
Print #filenumber, ""
Print #filenumber, "MITGLIEDSNUMMER" + s1 + "NACHNAME" + s1 + "VORNAME" + s1 + "STRASSE" + s1 + "PLZ" + s1 + "ORT" + s1 + "IBAN" + s1 + "BIC" + s1 + "BANKNAME1" + s1 + "BANKNAME2" + s1 + "BHKONTONUMMER" + s1 + "NETTO" + s1 + "MWST PROZENT " + s1 + "MWST" + s1 + "BRUTTO"

End Sub

Sub PrintAuszahlungCDFFooter(filenumber)


End Sub




' ******************************************************************************
' BMD EXPORT: PERSONENKONTEN
' ******************************************************************************


Sub PrintAuszahlungBMDData(filenumber)

Dim line1 As String
Dim str1 As String

line1 = ""
str1 = ""

'bhkontonr
str1 = FillUp(bhkontonr1, 6, 1, "0")
line1 = line1 + str1
'MsgBox (str1)

'buchungsdatum
str1 = Format(year(Buchungsdatum1) - 2000, "00") + Format(Month(Buchungsdatum1), "00") + Format(Day(Buchungsdatum1), "00")
line1 = line1 + str1
'MsgBox (str1)

'gegenkonto
str1 = FillUp(Gegenkonto1, 6, 1, "0")
line1 = line1 + str1
'MsgBox (str1)

'belegnummer
str1 = FillUp(Belegnummer1, 6, 1, "0")
line1 = line1 + str1
'MsgBox (str1)

'belegdatum
str1 = Format(year(Belegdatum1) - 2000, "00") + Format(Month(Belegdatum1), "00") + Format(Day(Belegdatum1), "00")
line1 = line1 + str1
'MsgBox (str1)

'kostenstelle
str1 = FillUp(Kostenstelle1, 6, 1, "0")
line1 = line1 + str1
'MsgBox (str1)

'mwstprozent
str1 = Format(mwstprozent1, "00")
line1 = line1 + str1
'MsgBox (str1)

'steuercode
str1 = FillUp(Steuercode1, 1, 1, "0")
line1 = line1 + str1
'MsgBox (str1)

'buchungscode
str1 = FillUp(Buchungscode1, 1, 1, "0")
line1 = line1 + str1
'MsgBox (str1)

'buchungsbetrag
str1 = Format(brutto1 * 100, "00000000000")
If Buchungscode1 = "1" Then
 str1 = str1 + "+"
Else
 str1 = str1 + "-"
End If
line1 = line1 + str1
'MsgBox (str1)

'steuerbetrag
'str1 = Format(mwst1 * 100, "00000000000")
'If Buchungscode1 = "1" Then
' str1 = str1 + "+"
'Else
' str1 = str1 + "-"
'End If
str1 = "00000000000-"
line1 = line1 + str1
'MsgBox (str1)

'buchungstext
Select Case Forms!FAuszahlung!TZahlungNr
 Case 1: str1 = "1.TEILZ " + Format(Forms!FAuszahlung!TLesejahr)
 Case 2: str1 = "2.TEILZ " + Format(Forms!FAuszahlung!TLesejahr)
 Case 3: str1 = "3.TEILZ " + Format(Forms!FAuszahlung!TLesejahr)
 Case 4: str1 = "4.TEILZ " + Format(Forms!FAuszahlung!TLesejahr)
 Case 5: str1 = Left(GetParameter("FREIERAUSZAHLUNGSTITEL"), 7) + " " + Format(Forms!FAuszahlung!TLesejahr)
 Case 6: str1 = "ENDAUSZ " + Format(Forms!FAuszahlung!TLesejahr)
 Case 7: str1 = "PROBEZ " + Format(Forms!FAuszahlung!TLesejahr)
End Select
'str1 = FillUp(nachname1 + " " + vorname1, 12, 0, " ")
line1 = line1 + str1
'MsgBox (str1)

'zahlungsziel
str1 = FillUp(Zahlungsziel1, 3, 1, "0")
line1 = line1 + str1
'MsgBox (str1)

'skonto %
str1 = FillUp(Skonto1, 3, 1, "0")
line1 = line1 + str1
'MsgBox (str1)

'skonto tage
str1 = FillUp(Skonto2, 3, 1, "0")
line1 = line1 + str1
'MsgBox (str1)

'Vertreter Nr
str1 = FillUp(Vertreter1, 3, 1, "0")
line1 = line1 + str1
'MsgBox (str1)

'provision
str1 = FillUp(Provision1, 3, 1, "0")
line1 = line1 + str1
'MsgBox (str1)

'benutzernummer
str1 = FillUp(Benutzernummer1, 1, 1, "0")
line1 = line1 + str1
'MsgBox (str1)

'Belegsymbol
str1 = FillUp(Belegsymbol1, 2, 1, "0")
line1 = line1 + str1
'MsgBox (str1)

'platzhalter "    "
str1 = "    "
line1 = line1 + str1
'MsgBox (str1)

'sperrcode
str1 = "0"
line1 = line1 + str1
'MsgBox (str1)

'stern
str1 = "*"
line1 = line1 + str1
'MsgBox (str1)

Print #filenumber, line1

End Sub



Sub PrintAuszahlungBMDHeader(filenumber)

Dim zahlungszieldatum As Date
Dim zahlungszieltage As Integer

'DoCmd.OpenForm
Do
 Buchungsdatum1 = InputBox("Buchungsdatum: ", , Format(Date, "dd.mm.yyyy"))
 If IsNull(Buchungsdatum1) Then
  MsgBox "Bitte geben Sie ein gültiges Datum im Format TT.MM.JJJJ ein", vbCritical, "UNGÜLTIGE EINGABE"
 End If
Loop While IsNull(Buchungsdatum1)

Do
 Belegdatum1 = InputBox("Belegdatum: ", , Format(Buchungsdatum1, "dd.mm.yyyy"))
 If IsNull(Buchungsdatum1) Then
  MsgBox "Bitte geben Sie ein gültiges Datum im Format TT.MM.JJJJ ein", vbCritical, "UNGÜLTIGE EINGABE"
 End If
Loop While IsNull(Belegdatum1)

Do
 zahlungszieldatum = InputBox("Zahlungsziel: ", , Format(Buchungsdatum1, "dd.mm.yyyy"))
 If IsNull(Buchungsdatum1) Then
  MsgBox "Bitte geben Sie ein gültiges Datum im Format TT.MM.JJJJ ein", vbCritical, "UNGÜLTIGE EINGABE"
 End If
Loop While IsNull(zahlungszieldatum)

zahlungszieltage = zahlungszieldatum - Buchungsdatum1
Zahlungsziel1 = Format(zahlungszieltage)

Kostenstelle1 = "000000"
Gegenkonto1 = "000000"
Belegnummer1 = "000000"
Steuercode1 = "0"
Buchungscode1 = "2"
Skonto1 = "000"
Skonto2 = "000"
Vertreter1 = "001"
Provision1 = "000"
Benutzernummer1 = "1"
Belegsymbol1 = "AG"

DoCmd.Hourglass True

End Sub


Sub PrintAuszahlungBMDFooter(filenumber)

If MsgBox("Wollen Sie auch die Mitgliederstammdaten exportieren ?", vbYesNo) = vbYes Then
 
 DoCmd.OpenForm "MExportMitglieder"

End If

End Sub



' ******************************************************************************
' BMD EXPORT: SACHKONTEN
' ******************************************************************************


Sub PrintAuszahlungBMDSakoData(filenumber)


End Sub



Sub PrintAuszahlungBMDSakoHeader(filenumber)

Dim zahlungszieldatum As Date
Dim zahlungszieltage As Integer

'DoCmd.OpenForm

Do
 BruttoKonto = InputBox("Sachkonto Brutto: ", , "003310")
 If IsNull(Buchungsdatum1) Then
  MsgBox "Bitte geben Sie eine gültige Buchhaltungs-Kontonummer ein !"
 End If
Loop While IsNull(BruttoKonto)

Do
 NettoKonto = InputBox("Sachkonto Netto: ", , "005100")
 If IsNull(Buchungsdatum1) Then
  MsgBox "Bitte geben Sie eine gültige Buchhaltungs-Kontonummer ein !"
 End If
Loop While IsNull(NettoKonto)

Do
 MwStKonto = InputBox("Sachkonto MwSt: ", , "002510")
 If IsNull(Buchungsdatum1) Then
  MsgBox "Bitte geben Sie eine gültige Buchhaltungs-Kontonummer ein !"
 End If
Loop While IsNull(MwStKonto)

Do
 Buchungsdatum1 = InputBox("Buchungsdatum: ", , Format(Date, "dd.mm.yyyy"))
 If IsNull(Buchungsdatum1) Then
  MsgBox "Bitte geben Sie ein gültiges Datum im Format TT.MM.JJJJ ein", vbCritical, "UNGÜLTIGE EINGABE"
 End If
Loop While IsNull(Buchungsdatum1)

Do
 Belegdatum1 = InputBox("Belegdatum: ", , Format(Buchungsdatum1, "dd.mm.yyyy"))
 If IsNull(Buchungsdatum1) Then
  MsgBox "Bitte geben Sie ein gültiges Datum im Format TT.MM.JJJJ ein", vbCritical, "UNGÜLTIGE EINGABE"
 End If
Loop While IsNull(Belegdatum1)

Kostenstelle1 = "000000"
Gegenkonto1 = "000000"
Belegnummer1 = "000000"
Steuercode1 = "0"
Benutzernummer1 = "1"
Belegsymbol1 = "  "
mwstprozent1 = 0
DoCmd.Hourglass True

End Sub


Sub PrintAuszahlungBMDSakoFooter(filenumber)

Dim line1 As String
Dim str1 As String


' 1. Bruttobuchung
' ================

line1 = ""
str1 = ""
mwstprozent1 = 0

'bhkontonr
str1 = FillUp(BruttoKonto, 6, 1, "0")
line1 = line1 + str1

'buchungsdatum
str1 = Format(year(Buchungsdatum1) - 2000, "00") + Format(Month(Buchungsdatum1), "00") + Format(Day(Buchungsdatum1), "00")
line1 = line1 + str1

'gegenkonto
str1 = FillUp(Gegenkonto1, 6, 1, "0")
line1 = line1 + str1

'belegnummer
str1 = FillUp(Belegnummer1, 6, 1, "0")
line1 = line1 + str1

'belegdatum
str1 = Format(year(Belegdatum1) - 2000, "00") + Format(Month(Belegdatum1), "00") + Format(Day(Belegdatum1), "00")
line1 = line1 + str1

'kostenstelle
str1 = FillUp(Kostenstelle1, 6, 1, "0")
line1 = line1 + str1

'mwstprozent
str1 = Format(mwstprozent1, "00")
line1 = line1 + str1

'steuercode
str1 = FillUp(Steuercode1, 1, 1, "0")
line1 = line1 + str1

'buchungscode
Buchungscode1 = "2"
str1 = FillUp(Buchungscode1, 1, 1, "0")
line1 = line1 + str1

'buchungsbetrag
str1 = Format(sum_brutto1 * 100, "00000000000")
str1 = str1 + "-"
line1 = line1 + str1

'steuerbetrag
str1 = "00000000000-"
line1 = line1 + str1

'buchungstext
Select Case Forms!FAuszahlung!TZahlungNr
 Case 1: str1 = "1.TEILZ " + Format(Forms!FAuszahlung!TLesejahr)
 Case 2: str1 = "2.TEILZ " + Format(Forms!FAuszahlung!TLesejahr)
 Case 3: str1 = "3.TEILZ " + Format(Forms!FAuszahlung!TLesejahr)
 Case 4: str1 = "4.TEILZ " + Format(Forms!FAuszahlung!TLesejahr)
 Case 5: str1 = Left(GetParameter("FREIERAUSZAHLUNGSTITEL"), 7) + " " + Format(Forms!FAuszahlung!TLesejahr)
 Case 6: str1 = "ENDAUSZ " + Format(Forms!FAuszahlung!TLesejahr)
 Case 7: str1 = "PROBEZ " + Format(Forms!FAuszahlung!TLesejahr)
End Select
str1 = FillUp(str1, 18, 0, " ")
line1 = line1 + str1

'platzhalter: 0
str1 = "0"
line1 = line1 + str1

'buchungsmonat: 00
str1 = "00"
line1 = line1 + str1

'platzhalter: 000000
str1 = "000000"
line1 = line1 + str1

'benutzernummer
str1 = FillUp(Benutzernummer1, 1, 1, "0")
line1 = line1 + str1

'Belegsymbol
str1 = FillUp(Belegsymbol1, 2, 1, "0")
line1 = line1 + str1

'platzhalter "    "
str1 = "    "
line1 = line1 + str1

'sperrcode
str1 = "0"
line1 = line1 + str1

'stern
str1 = "*"
line1 = line1 + str1

Print #filenumber, line1



' 2. Nettobuchung
' ================

line1 = ""
str1 = ""

'bhkontonr
str1 = FillUp(NettoKonto, 6, 1, "0")
line1 = line1 + str1

'buchungsdatum
str1 = Format(year(Buchungsdatum1) - 2000, "00") + Format(Month(Buchungsdatum1), "00") + Format(Day(Buchungsdatum1), "00")
line1 = line1 + str1

'gegenkonto
str1 = FillUp(Gegenkonto1, 6, 1, "0")
line1 = line1 + str1

'belegnummer
str1 = FillUp(Belegnummer1, 6, 1, "0")
line1 = line1 + str1

'belegdatum
str1 = Format(year(Belegdatum1) - 2000, "00") + Format(Month(Belegdatum1), "00") + Format(Day(Belegdatum1), "00")
line1 = line1 + str1

'kostenstelle
str1 = FillUp(Kostenstelle1, 6, 1, "0")
line1 = line1 + str1

'mwstprozent
str1 = Format(mwstprozent1, "00")
line1 = line1 + str1

'steuercode
str1 = FillUp(Steuercode1, 1, 1, "0")
line1 = line1 + str1

'buchungscode
Buchungscode1 = "1"
str1 = FillUp(Buchungscode1, 1, 1, "0")
line1 = line1 + str1

'buchungsbetrag
str1 = Format(sum_netto1 * 100, "00000000000")
str1 = str1 + "+"
line1 = line1 + str1

'steuerbetrag
str1 = "00000000000+"
line1 = line1 + str1

'buchungstext
Select Case Forms!FAuszahlung!TZahlungNr
 Case 1: str1 = "1.TEILZ " + Format(Forms!FAuszahlung!TLesejahr)
 Case 2: str1 = "2.TEILZ " + Format(Forms!FAuszahlung!TLesejahr)
 Case 3: str1 = "3.TEILZ " + Format(Forms!FAuszahlung!TLesejahr)
 Case 4: str1 = "4.TEILZ " + Format(Forms!FAuszahlung!TLesejahr)
 Case 5: str1 = Left(GetParameter("FREIERAUSZAHLUNGSTITEL"), 7) + " " + Format(Forms!FAuszahlung!TLesejahr)
 Case 6: str1 = "ENDAUSZ " + Format(Forms!FAuszahlung!TLesejahr)
 Case 7: str1 = "PROBEZ " + Format(Forms!FAuszahlung!TLesejahr)
End Select
str1 = FillUp(str1, 18, 0, " ")
line1 = line1 + str1

'platzhalter: 0
str1 = "0"
line1 = line1 + str1

'buchungsmonat: 00
str1 = "00"
line1 = line1 + str1

'platzhalter: 000000
str1 = "000000"
line1 = line1 + str1

'benutzernummer
str1 = FillUp(Benutzernummer1, 1, 1, "0")
line1 = line1 + str1

'Belegsymbol
str1 = FillUp(Belegsymbol1, 2, 1, "0")
line1 = line1 + str1

'platzhalter "    "
str1 = "    "
line1 = line1 + str1

'sperrcode
str1 = "0"
line1 = line1 + str1

'stern
str1 = "*"
line1 = line1 + str1

Print #filenumber, line1




' 3. MwStbuchung
' ================

line1 = ""
str1 = ""

'bhkontonr
str1 = FillUp(MwStKonto, 6, 1, "0")
line1 = line1 + str1

'buchungsdatum
str1 = Format(year(Buchungsdatum1) - 2000, "00") + Format(Month(Buchungsdatum1), "00") + Format(Day(Buchungsdatum1), "00")
line1 = line1 + str1

'gegenkonto
str1 = FillUp(Gegenkonto1, 6, 1, "0")
line1 = line1 + str1

'belegnummer
str1 = FillUp(Belegnummer1, 6, 1, "0")
line1 = line1 + str1

'belegdatum
str1 = Format(year(Belegdatum1) - 2000, "00") + Format(Month(Belegdatum1), "00") + Format(Day(Belegdatum1), "00")
line1 = line1 + str1

'kostenstelle
str1 = FillUp(Kostenstelle1, 6, 1, "0")
line1 = line1 + str1

'mwstprozent
str1 = Format(mwstprozent1, "00")
line1 = line1 + str1

'steuercode
str1 = FillUp(Steuercode1, 1, 1, "0")
line1 = line1 + str1

'buchungscode
Buchungscode1 = "1"
str1 = FillUp(Buchungscode1, 1, 1, "0")
line1 = line1 + str1

'buchungsbetrag
str1 = Format(sum_mwst1 * 100, "00000000000")
str1 = str1 + "+"
line1 = line1 + str1

'steuerbetrag
str1 = "00000000000+"
line1 = line1 + str1

'buchungstext
Select Case Forms!FAuszahlung!TZahlungNr
 Case 1: str1 = "1.TEILZ " + Format(Forms!FAuszahlung!TLesejahr)
 Case 2: str1 = "2.TEILZ " + Format(Forms!FAuszahlung!TLesejahr)
 Case 3: str1 = "3.TEILZ " + Format(Forms!FAuszahlung!TLesejahr)
 Case 4: str1 = "4.TEILZ " + Format(Forms!FAuszahlung!TLesejahr)
 Case 5: str1 = Left(GetParameter("FREIERAUSZAHLUNGSTITEL"), 7) + " " + Format(Forms!FAuszahlung!TLesejahr)
 Case 6: str1 = "ENDAUSZ " + Format(Forms!FAuszahlung!TLesejahr)
 Case 7: str1 = "PROBEZ " + Format(Forms!FAuszahlung!TLesejahr)
End Select
str1 = FillUp(str1, 18, 0, " ")
line1 = line1 + str1

'platzhalter: 0
str1 = "0"
line1 = line1 + str1

'buchungsmonat: 00
str1 = "00"
line1 = line1 + str1

'platzhalter: 000000
str1 = "000000"
line1 = line1 + str1

'benutzernummer
str1 = FillUp(Benutzernummer1, 1, 1, "0")
line1 = line1 + str1

'Belegsymbol
str1 = FillUp(Belegsymbol1, 2, 1, "0")
line1 = line1 + str1

'platzhalter "    "
str1 = "    "
line1 = line1 + str1

'sperrcode
str1 = "0"
line1 = line1 + str1

'stern
str1 = "*"
line1 = line1 + str1

Print #filenumber, line1




End Sub









' ******************************************************************************
' DBF EXPORT
' ******************************************************************************

Sub PrintAuszahlungDBFData(filenumber)

' Do nothing

End Sub


Sub PrintAuszahlungDBFHeader(filenumber)

Dim SEL1 As String
Dim GROUP1 As String
Dim where1 As String
Dim order1 As String
Dim query1
Dim savepath1
Dim temptablename1

SEL1 = "SELECT DISTINCT TMitglieder.MGNR, TMitglieder.Nachname, TMitglieder.Vorname, TMitglieder.Straße as STRASSE, TMitglieder.PLZ, TMitglieder.Ort, TMitglieder.KontoNr, TMitglieder.BLZ, TBanken.Name1 AS Bank, TMitglieder.BHKontonummer AS BHKONTO, CCur(Sum(IIf([Formulare]![FAuszahlung]![TZahlungNr]=1,[BTeilzahlung1],IIf([Formulare]![FAuszahlung]![TZahlungNr]=2,[BTeilzahlung2],IIf([Formulare]![FAuszahlung]![TZahlungNr]=3,[BTeilzahlung3],IIf([Formulare]![FAuszahlung]![TZahlungNr]=4,[BTeilzahlung4],IIf([Formulare]![FAuszahlung]![TZahlungNr]=5,[BTeilzahlung5],IIf([Formulare]![FAuszahlung]![TZahlungNr]=6,[BEndauszahlung]-[BTeilzahlung4]-[BTeilzahlung3]-[BTeilzahlung2]-[BTeilzahlung1],[BProbeauszahlung])))))))) AS NETTO, First(IIf([Buchführend],Getparameter('MWST2'),GetPArameter('MWST1'))) AS MWSTPROZ, Runden(NETTO*MWSTPROZ/100,2) as MWST, Runden(NETTO*(MWSTPROZ+100)/100,2) as BRUTTO"
SEL1 = SEL1 + " FROM TBanken RIGHT JOIN (TMitglieder RIGHT JOIN TLieferungen ON TMitglieder.MGNR = TLieferungen.MGNR) ON TBanken.BLZ = TMitglieder.BLZ "
GROUP1 = " GROUP BY TMitglieder.MGNR, TMitglieder.Nachname, TMitglieder.Vorname, TMitglieder.Straße, TMitglieder.PLZ, TMitglieder.Ort, TMitglieder.KontoNr, TMitglieder.BLZ, TBanken.Name1, TMitglieder.BHKontonummer "

Select Case OSortierung

Case 1: order1 = " ORDER BY TMitglieder.MGNR "

Case 2: order1 = " ORDER BY TMitglieder.PLZ, TMitglieder.Ort, TMitglieder.Nachname, TMitglieder.Vorname "

End Select

where1 = " WHERE Year(Datum)=" + Format(Forms!FAuszahlung!TLesejahr) + " AND Storniert=false "


If Not IsNull(Forms!FAuszahlung!TZNR) And Forms!FAuszahlung!TZNR <> "" Then
 where1 = where1 + " AND TLieferungen.ZNR=" + Format(Forms!FAuszahlung!TZNR)
End If

If Not IsNull(Forms!FAuszahlung!TVon) And Forms!FAuszahlung!TVon >= 0 Then

    If OSortierung = 1 Then
      where1 = where1 + " AND TLieferungen.MGNR>=" + Format(Forms!FAuszahlung!TVon) + " "
    Else
      where1 = where1 + " AND TMitglieder.PLZ>=" + Format(Forms!FAuszahlung!TVon) + " "
    End If

End If

If Not IsNull(Forms!FAuszahlung!TBis) And Forms!FAuszahlung!TBis >= 0 Then

    If OSortierung = 1 Then
      where1 = where1 + " AND TLieferungen.MGNR<=" + Format(Forms!FAuszahlung!TBis) + " "
    Else
      where1 = where1 + " AND TMitglieder.PLZ<=" + Format(Forms!FAuszahlung!TBis) + " "
    End If



End If


query1 = SEL1 + where1 + GROUP1 + order1

'savepath1 = InputBox("Excel Datei speichern unter:", "EXCEL DATEI EXPORTIEREN", "C:\Eigene Dateien\auszahlung.xls")
'If IsNull(savepath) Or savepath1 = "" Then
' Exit Sub
'End If

DoCmd.Hourglass True

queryname1 = "AAuszahlungExport"
temptablename1 = "xTempAuszahlungExport"
Dim db1 As Database
Set db1 = CurrentDb

'On Error Resume Next
If QueryExists(queryname1) = True Then
 DoCmd.DeleteObject acQuery, queryname1
End If
db1.CreateQueryDef queryname1, query1
db1.Close

'DoCmd.TransferSpreadsheet acExport, 0, queryname1, TExportDatei, True
DoCmd.TransferDatabase acExport, "DBASE IV", GetPathFromFullName(TExportDatei), acQuery, queryname1, GetFilenameFromFullName(TExportDatei)

'use table instead of query

Dim rs1 As Recordset

Set db1 = CurrentDb
If TableExists(temptablename1) Then
 db1.Execute ("DROP TABLE " + temptablename1)
End If
'db1.Execute ("CREATE TABLE xTempAuszahlungExport (MGNR LONG, Nachname TEXT, Vorname TEXT, STRASSE TEXT, PLZ TEXT, Ort TEXT, KontoNr TEXT,BLZ TEXT, Bank TEXT, BHKONTO TEXT, NETTO DOUBLE, MWSTPROZ DOUBLE, MWST DOUBLE, BRUTTO DOUBLE);")


'reimport file for AnteilAuszahlung
DoCmd.TransferDatabase acImport, "DBASE IV", GetPathFromFullName(TExportDatei), acTable, GetFilenameFromFullName(TExportDatei), temptablename1

Set rs1 = db1.OpenRecordset(temptablename1)
While Not rs1.EOF
 rs1.Edit
 
 'Anteil % anwenden
 Select Case LAuszahlungsAnteil
 Case 0: '100%
  'rs1!Netto keeps unchanged
 Case 1: '50% Teilzahlung
  rs1!Netto = Runden(rs1!Netto * 50 / 100, 2)
 Case 2: '50% Restzahlung
  rs1!Netto = rs1!Netto - Runden(rs1!Netto * 50 / 100, 2)

 End Select
 
 rs1!mwst = Runden(rs1!Netto * rs1!mwstproz / 100, 2)
 rs1!Brutto = Runden(rs1!Netto * (100 + rs1!mwstproz) / 100, 2)
 
 rs1.Update
 rs1.MoveNext
 
Wend
rs1.Close

'DoCmd.TransferDatabase acExport, "DBASE IV", GetPathFromFullName(TExportDatei), acTable, temptablename1, GetFilenameFromFullName(TExportDatei)

If QueryExists(queryname1) = True Then
 DoCmd.DeleteObject acQuery, queryname1
End If
db1.CreateQueryDef queryname1, "SELECT * FROM " + temptablename1 + " ORDER BY MGNR"
DoCmd.TransferDatabase acExport, "DBASE IV", GetPathFromFullName(TExportDatei), acQuery, queryname1, GetFilenameFromFullName(TExportDatei)




End Sub


Sub PrintAuszahlungDBFFooter(filenumber)

' Do nothing

End Sub






' ******************************************************************************
' ELBA EXPORT
' ******************************************************************************


Sub PrintAuszahlungElbaData(filenumber)

Dim s1 As String
s1 = Chr(9)

'CP 04.07.2007: Nur Werte >0 exportieren
If brutto1 > 0 Then
 Print #filenumber, Format(brutto1, "0.00") + s1 + BIC + s1 + IBAN + s1 + nachname1 + " " + vorname1 + s1 + plz1 + " " + ort1
End If

End Sub


Sub PrintAuszahlungElbaHeader(filenumber)

Dim line1 As String
Dim s1 As String
s1 = Chr(9)
line1 = ""

'Print #filenumber, "AUSZAHLUNGSLISTE"
'Print #filenumber, "für Lesejahr " + Format(Forms!FAuszahlung!TLesejahr)

'Select Case Forms!FAuszahlung!TZahlungNr
' Case 1: Print #filenumber, "1. Teilzahlung"
' Case 2: Print #filenumber, "2. Teilzahlung"
' Case 3: Print #filenumber, "3. Teilzahlung"
' Case 4: Print #filenumber, "4. Teilzahlung"
' Case 5:
'         If IsNull(GetParameter("FREIERAUSZAHLUNGSTITEL")) Then
'          Print #filenumber, ""
'         Else
'          Print #filenumber, GetParameter("FREIERAUSZAHLUNGSTITEL")
'         End If
' Case 6: Print #filenumber, "Endauszahlung"
' Case 7: Print #filenumber, "Probeauszahlung"
'End Select
 
'Print #filenumber, Forms!FAuszahlung!TTitel
'Print #filenumber, ""
'Print #filenumber, "MITGLIEDSNUMMER" + s1 + "NACHNAME" + s1 + "VORNAME" + s1 + "STRASSE" + s1 + "PLZ" + s1 + "ORT" + s1 + "KONTONUMMER" + s1 + "BLZ" + s1 + "BANKNAME1" + s1 + "BANKNAME2" + s1 + "BHKONTONUMMER" + s1 + "NETTO" + s1 + "MWST PROZENT " + s1 + "MWST" + s1 + "BRUTTO"

End Sub

Sub PrintAuszahlungElbaFooter(filenumber)


End Sub



' ******************************************************************************
' MISC FUNCTIONS
' ******************************************************************************


Function QueryExists(query1) As Boolean

Dim db1 As Database
Set db1 = CurrentDb
Dim x As QueryDef

For Each x In db1.QueryDefs
 If x.Name = query1 Then
   'MsgBox (X.Name)
   QueryExists = True
   Exit Function
 End If
Next x

   QueryExists = False

End Function


Function TableExists(table1) As Boolean

Dim db1 As Database
Set db1 = CurrentDb
Dim x As TableDef

For Each x In db1.TableDefs
 If x.Name = table1 Then
   TableExists = True
   Exit Function
 End If
Next x

   TableExists = False

End Function



Function GetPathFromFullName(fullname As String) As String

Dim i
Dim path1

i = Len(fullname)

While i > 1 And Mid(fullname, i, 1) <> "\"
 i = i - 1
Wend

If i = 1 Then
 path1 = "C:\"
Else
 path1 = Left(fullname, i - 1)
End If
'MsgBox (path1)
If InStr(path1, "\") = 0 Then
 path1 = path1 + "\"
End If


GetPathFromFullName = path1

End Function


Function GetFilenameFromFullName(fullname As String) As String

Dim i
Dim filename1

i = Len(fullname)

While i > 1 And Mid(fullname, i, 1) <> "\"
 i = i - 1
Wend

If i > 1 Then i = i + 1

filename1 = Mid(fullname, i)
'MsgBox (filename1)
GetFilenameFromFullName = filename1

End Function


Function FillUp(text1 As String, laenge1 As Long, left1 As Long, fillchar1 As String) As String

Dim str1 As String

str1 = text1

If Len(str1) > laenge1 Then
' it is too long
 str1 = Left(str1, laenge1)
End If

While (Len(str1) < laenge1)
 ' it is still too short
 If left1 Then
  str1 = fillchar1 + str1
 Else
  str1 = str1 + fillchar1
 End If
Wend


FillUp = str1

End Function



Function Fileexists(filename As String) As Boolean

On Error GoTo NoFile

If FileSystem.GetAttr(filename) >= 0 Then
 Fileexists = True
Else
 Fileexists = False
End If

Exit Function

NoFile:
 Fileexists = False
 Exit Function

End Function


Public Function Runden(value1 As Double, digits As Integer) As Double

Dim temp1 As Double

temp1 = value1 * (10 ^ digits)

If (temp1 * 10) Mod 10 = 5 Then
 temp1 = temp1 + 1
 temp1 = Fix(temp1)
 temp1 = temp1 / (10 ^ digits)
 Runden = temp1
Else
 Runden = CLng(value1 * (10 ^ digits)) / (10 ^ digits)
End If

End Function