Export selected records instead of printing them?

Clueless Newbie

Immortal. So far.
Local time
Today, 11:33
Joined
Feb 6, 2004
Messages
48
Hi everyone,

One of my forms is a search form in which the user can later select one or more records from the search result. The selected records can then be printed at the click of a button:

Code:
Private Sub DruckHauptfunktion_Click()
On Error Resume Next

Dim db1 As Database
    
    Dim rs As Recordset      'DruckReihenfolge
    Dim f As Form
    Dim I As Integer
    Dim strKriterien As String
    Dim SQery As String
    Dim Anzahl As Integer
    
    squery = Me!DSelektion
    If IsNull(squery) Then
        I = MsgBox("Funktion nicht realisiert")
        Exit Sub
    End If

    Set db1 = CurrentDb     'Datenbank öffnen.
    On Error Resume Next
    
    
    DoCmd.SetWarnings False
        DoCmd.RunSQL "DELETE * FROM DruckTAB;"
    DoCmd.SetWarnings False
    
    Set rs = db1.OpenRecordset("DruckTAB", dbOpenDynaset)
    
    Me!AnzahlUnternehmen = 0
    Me!GesellschaftsKurzname.Visible = True
    Me!AnzahlUnternehmen.Visible = True
    
    
    Dim ctlQuelle As Control
    Dim strElemente As Long
    Dim intAktuelleZeile As Integer
    Set ctlQuelle = Forms!Syssuche!Listbox1
    
    For intAktuelleZeile = 0 To ctlQuelle.ListCount - 1
        If ctlQuelle.Selected(intAktuelleZeile) Then
            'strElemente = ctlQuelle.Column(0, intAktuelleZeile)
            'If Not IsNull(strElemente) Or strelelemente <> 0 Then
                rs.AddNew
                If Forms!Syssuche!SelektionsFeld = 1 Then
                    rs!GesellschaftsID = ctlQuelle.Column(0, intAktuelleZeile)
                    rs!Name1 = ctlQuelle.Column(1, intAktuelleZeile)
                Else
                    rs!GesellschaftsID = ctlQuelle.Column(1, intAktuelleZeile)
                    rs!Name1 = ctlQuelle.Column(2, intAktuelleZeile)
                End If
                If rs!GesellschaftsID <> 0 Then
                    rs.Update
                Else
                    rs.Delete
                End If
            'End If
        End If
    Next intAktuelleZeile
        
    
    rs.MoveLast
    rs.MoveFirst
    Anzahl = rs.RecordCount
    DoCmd.Close A_FORM, "SYSSUCHE"
    If Anzahl = 0 Or Anzahl = Null Then
        X = MsgBox("Keine Gesellschaft für den Druck ausgewählt, Abbruch!", vbInformation + vbOKOnly, "Hinweis")
        Exit Sub
    End If
    If Anzahl > 1 Then
        I = MsgBox("Wollen Sie " & Anzahl & " Gesellschaftsdatenblätter ausgeben?", vbOKCancel + vbQuestion + vbDefaultButton1, "Kontrollabfrage")
    Else
        I = MsgBox("Wollen Sie ein Gesellschaftsdatenblatt ausgeben?", vbOKCancel + vbQuestion + vbDefaultButton1, "Kontrollabfrage")
    End If
    
    If I <> 1 Then Exit Sub
    
    Do While Not rs.EOF
        rs.Edit
        Forms!Druckauswahl!GesellschaftsID = rs!GesellschaftsID
        f!GesellschaftsID = rs!GesellschaftsID
        Forms!Druckauswahl!GesellschaftsKurzname = rs!Name1
        Anzahl = Anzahl + 1
        f!AnzahlUnternehmen = Anzahl
        'F!UnternehmensID = RS!GesellschaftsID
        Me.Repaint
        If IsNull(f!GesellschaftsID) Or f!GesellschaftsID = 0 Then
            Beep
        Else
        stDocName = "Druckauswahl_Dyn"
        DoCmd.OpenReport stDocName, acNormal 'acViewNormal
        For I = 1 To 10000
        Next
        End If
        rs.MoveNext
    Loop
    

End Sub

I need to also implement a separate button with what I hope will be a similar function which doesn't print the selected files but exports them to a tab delimited .txt file in a specific directory. The filename consists of a static string "FileNet_" plus the current date in yyyymmtt format. Should/Can I modify my print function for this purpose or can this be done more easily?

Regards & thanks,

Ute
 
Last edited:
Did it... ;)

Why is it that I first spend hours wrecking my brain over a problem, and as soon as I've posted it here I suddenly find the solution myself? :confused: :rolleyes:

Ute
 

Users who are viewing this thread

Back
Top Bottom