'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 betriebsnummer1 As String Dim ga1 As String Dim ga2 As String Dim eintrittsdatum1 As String Dim austrittsdatum1 As String Dim buchführend1 As String Dim anmerkung1 As String Dim aktivesmitglied1 As String Dim bhkontonr1 As String Dim blz1 As String Dim bankname1 As String Dim bankname2 As String Dim kontonr1 As String Dim zweigstelle1 As String 'Globals for bmd export Dim Branche1 As String Dim Auslandscode1 As String Dim Zahlungsziel1 As String Dim Skonto1 As String Dim Skonto2 As String Dim Mahncode1 As String Dim Verkaufsgebiet1 As String Private Sub BOk_Click() If Fileexists(TExportDatei) Then If MsgBox("Datei " + TExportDatei + " existiert bereits ! Überschreiben", vbYesNo) = vbYes Then ExportMitglieder (TExportDatei) DoCmd.Close End If Else If Not IsNull(TExportDatei) And TExportDatei <> "" Then ExportMitglieder (TExportDatei) 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 "MITGLIEDEREXPORTDATEI1", TExportDatei Case 2: ' BMD SetParameter "MITGLIEDEREXPORTDATEI2", TExportDatei End Select End If SetParameter "MITGLIEDEREXPORTDEFAULT", OExportOption End Sub Private Sub Form_Open(Cancel As Integer) If IsNull(GetParameter("MITGLIEDEREXPORTDEFAULT")) Then SetParameter "MITGLIEDEREXPORTDEFAULT", 1 End If OExportOption = GetParameter("MITGLIEDEREXPORTDEFAULT") Select Case OExportOption Case 1: 'CDF If IsNull(GetParameter("MITGLIEDEREXPORTDATEI1")) Then SetParameter "MITGLIEDEREXPORTDATEI1", "C:\MITGLIEDER.TXT" End If TExportDatei = GetParameter("MITGLIEDEREXPORTDATEI1") Case 2: 'BMD If IsNull(GetParameter("MITGLIEDEREXPORTDATEI2")) Then SetParameter "MITGLIEDEREXPORTDATEI2", "C:\PEKOSTAM.BMD" End If TExportDatei = GetParameter("MITGLIEDEREXPORTDATEI2") End Select End Sub 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 Sub ExportMitglieder(filename1 As String) Dim db1 As Database Dim rs_mitglieder As Recordset Dim query1 As String Dim Lesejahr1 As Long Dim rcounter As Long Dim line1 As String Dim filenum DoCmd.Hourglass True query1 = "SELECT TMitglieder.*, TZweigstellen.Name, TBanken.Name1, TBanken.Name2, TMitglieder.Nachname, TMitglieder.Vorname FROM (TBanken RIGHT JOIN TMitglieder ON TBanken.BLZ = TMitglieder.BLZ) LEFT JOIN TZweigstellen ON TMitglieder.ZNR = TZweigstellen.ZNR ORDER BY TMitglieder.Nachname, TMitglieder.Vorname" Set db1 = CurrentDb Set rs_mitglieder = db1.OpenRecordset(query1) rcounter = 0 sum_netto1 = 0 sum_mwst1 = 0 sum_brutto1 = 0 filenum = FreeFile On Error GoTo err1: Open filename1 For Output As filenum Select Case OExportOption Case 1: ' CDF PrintMitgliederCDFHeader (filenum) Case 2: ' BMD PrintMitgliederBMDHeader (filenum) End Select While Not rs_mitglieder.EOF mgnr1 = Format(rs_mitglieder![MGNR]) If IsNull(rs_mitglieder![TMitglieder.Nachname]) Then nachname1 = "" Else nachname1 = rs_mitglieder![TMitglieder.Nachname] If IsNull(rs_mitglieder![TMitglieder.Vorname]) Then vorname1 = "" Else vorname1 = rs_mitglieder![TMitglieder.Vorname] If IsNull(rs_mitglieder![Straße]) Then strasse1 = "" Else strasse1 = rs_mitglieder![Straße] If IsNull(rs_mitglieder![PLZ]) Then plz1 = "" Else plz1 = rs_mitglieder!PLZ If IsNull(rs_mitglieder!Ort) Then ort1 = "" Else ort1 = rs_mitglieder!Ort If IsNull(rs_mitglieder!BLZ) Then blz1 = "" Else blz1 = rs_mitglieder!BLZ If IsNull(rs_mitglieder!KontoNr) Then kontonr1 = "" Else kontonr1 = rs_mitglieder!KontoNr If IsNull(rs_mitglieder!BHKontonummer) Then bhkontonr1 = "" Else bhkontonr1 = rs_mitglieder!BHKontonummer If IsNull(rs_mitglieder!Name1) Then bankname1 = "" Else bankname1 = rs_mitglieder!Name1 If IsNull(rs_mitglieder!Name2) Then bankname2 = "" Else bankname2 = rs_mitglieder!Name2 If IsNull(rs_mitglieder!Name) Then zweigstelle1 = "" Else zweigstelle1 = rs_mitglieder!Name If IsNull(rs_mitglieder!Betriebsnummer) Then betriebsnummer1 = "" Else betriebsnummer1 = rs_mitglieder!Betriebsnummer If IsNull(rs_mitglieder![Geschäftsanteile1]) Then ga1 = "" Else ga1 = rs_mitglieder![Geschäftsanteile1] If IsNull(rs_mitglieder![Geschäftsanteile2]) Then ga2 = "" Else ga2 = rs_mitglieder![Geschäftsanteile2] If IsNull(rs_mitglieder![Eintrittsdatum]) Then eintrittsdatum1 = "" Else eintrittsdatum1 = Format(rs_mitglieder![Eintrittsdatum], "dd.mm.yyyy") If IsNull(rs_mitglieder![Austrittsdatum]) Then austrittsdatum1 = "" Else austrittsdatum1 = Format(rs_mitglieder![Austrittsdatum], "dd.mm.yyyy") If rs_mitglieder![Buchführend] Then buchführend1 = "buchführend" Else buchführend1 = "" If IsNull(rs_mitglieder![Anmerkung]) Then anmerkung1 = "" Else anmerkung1 = rs_mitglieder![Anmerkung] If rs_mitglieder![Aktives Mitglied] Then aktivesmitglied1 = "aktiv" Else aktivesmitglied1 = "" ' output to file Select Case OExportOption Case 1: ' CDF PrintMitgliederCDFData (filenum) Case 2: ' BMD PrintMitgliederBMDData (filenum) End Select rs_mitglieder.MoveNext rcounter = rcounter + 1 Wend Close filenum rs_mitglieder.Close DoCmd.Hourglass False MsgBox (Format(rcounter) + " Mitglieder erfolgreich exportiert !") Exit Sub err1: MsgBox "Datei bereits geöffnet !", vbCritical DoCmd.Hourglass False End Sub Private Sub OExportOption_Click() Select Case OExportOption Case 1: 'CDF If IsNull(GetParameter("MITGLIEDEREXPORTDATEI1")) Then SetParameter "MITGLIEDEREXPORTDATEI1", "C:\MITGLIEDER.TXT" End If TExportDatei = GetParameter("MITGLIEDEREXPORTDATEI1") Case 2: 'BMD If IsNull(GetParameter("MITGLIEDEREXPORTDATEI2")) Then SetParameter "MITGLIEDEREXPORTDATEI2", "C:\PEKOSTAM.BMD" End If TExportDatei = GetParameter("MITGLIEDEREXPORTDATEI2") End Select End Sub ' ****************************************************************************** ' THE EXPORT ROUTINES ' ****************************************************************************** ' ****************************************************************************** ' CDF EXPORT ' ****************************************************************************** Sub PrintMitgliederCDFData(filenumber) Dim s1 As String s1 = ";" Print #filenumber, mgnr1 + s1 + nachname1 + s1 + vorname1 + s1 + strasse1 + s1 + plz1 + s1 + ort1 + s1 + kontonr1 + s1 + blz1 + s1 + bankname1 + s1 + bankname2 + s1 + zweigstelle1 + s1 + betriebsnummer1 + s1 + ga1 + s1 + ga2 + s1 + Format(eintrittsdatum1) + s1 + Format(austrittsdatum1) + s1 + buchführend1 + s1 + aktivesmitglied1 End Sub Sub PrintMitgliederCDFHeader(filenumber) Dim line1 As String Dim s1 As String s1 = ";" line1 = "" Print #filenumber, "MITGLIEDERLISTE" Print #filenumber, "" Print #filenumber, "MITGLIEDSNUMMER" + s1 + "NACHNAME" + s1 + "VORNAME" + s1 + "STRASSE" + s1 + "PLZ" + s1 + "ORT" + s1 + "KONTONUMMER" + s1 + "BLZ" + s1 + "BANKNAME1" + s1 + "BANKNAME2" + s1 + "ZWEIGSTELLE" + s1 + "BETRIEBSNUMMER" + s1 + "GESCHÄFTSANTEILE1" + s1 + "GESCHÄFTSANTEILE2" + s1 + "EINTRITT" + s1 + "AUSTRITT" + s1 + "BUCHFÜHREND" + s1 + "AKTIVES MITGLIED" End Sub ' ****************************************************************************** ' BMD EXPORT ' ****************************************************************************** Sub PrintMitgliederBMDData(filenumber) Dim line1 As String Dim str1 As String line1 = "" str1 = "" 'bhkontonr str1 = FillUp(bhkontonr1, 6, 1, "0") line1 = line1 + str1 'MsgBox (str1) 'bezeichnung (name) str1 = FillUp(nachname1 + " " + vorname1, 30, 0, " ") line1 = line1 + str1 'MsgBox (str1) 'branche str1 = FillUp(Branche1, 25, 0, " ") line1 = line1 + str1 'MsgBox (str1) 'straße str1 = FillUp(strasse1, 20, 0, " ") line1 = line1 + str1 'MsgBox (str1) 'plz str1 = FillUp(plz1, 7, 0, " ") line1 = line1 + str1 'MsgBox (str1) 'ort str1 = FillUp(ort1, 20, 0, " ") line1 = line1 + str1 'MsgBox (str1) 'bankkonto str1 = FillUp(kontonr1, 20, 0, " ") line1 = line1 + str1 'MsgBox (str1) 'blz str1 = FillUp(blz1, 6, 0, " ") line1 = line1 + str1 'MsgBox (str1) 'auslandscode str1 = FillUp(Auslandscode1, 3, 1, "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) 'mahncode str1 = FillUp(Mahncode1, 3, 1, "0") line1 = line1 + str1 'MsgBox (str1) 'verkaufsgebiet str1 = FillUp(Verkaufsgebiet1, 3, 1, "0") line1 = line1 + str1 'MsgBox (str1) 'platzhalter " "x47 str1 = FillUp(" ", 47, 1, " ") line1 = line1 + str1 'MsgBox (str1) 'stern str1 = "*" line1 = line1 + str1 'MsgBox (str1) Print #filenumber, line1 End Sub Sub PrintMitgliederBMDHeader(filenumber) 'DoCmd.OpenForm Branche1 = " " Auslandscode1 = "000" Zahlungsziel1 = "000" Skonto1 = "000" Skonto2 = "000" Mahncode1 = "000" Verkaufsgebiet1 = "000" DoCmd.Hourglass True End Sub 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