Neuigkeiten:

Ist euer Problem gelöst, dann bitte den Knopf "Thema gelöst" drücken!

Mobiles Hauptmenü

Abfrage Problem

Begonnen von jensgebken, Januar 19, 2023, 10:00:09

⏪ vorheriges - nächstes ⏩

jensgebken

Hallo Gemeinschaft,

habe ein Abfrage Problem - erstelle eine Abfrage in dieser Art - in der ich Datensätze nacheinander bearbeite

während dieser Schleife ändere ich Werte in einer Tabelle Reservierungen (GutscheinNr) - dort trage ich einen Wert ein
Set DB = CurrentDb
    strSQL = "SELECT * FROM AbfrageEigentuemer"
    Set rs = DB.OpenRecordset(strSQL, dbOpenDynaset)
    Do Until rs.EOF

.....

am Ende aber noch innerhalb der geöffneten DB Abfrage kommt dieser Befehl

DoCmd.TransferText acExportDelim, "Export1801", "Abfrage6", "S:\abrechnung\Mietabrechnung" & Ablagedatum & ".csv", False

Die Abfrage6 wird über die Tabelle Reservierungen gemacht - mein Problem ist nur, dass innerhalb der Abfrage das Feld GutscheinNr noch nicht aktualisiert wurde, somit bekomme ich auch nicht dieses Feld in die Ausgabe

oder muss ich den DB Aufruf erst wieder schliessen und dann wieder öffnen

wenn ich mit rs.update arbeite - dann bekomme ich diese Meldung

update oder cancelupdate ohne addnew oder edit

wenn ich es so mache, dann bekomme ich den gleichen Fehler
rs.Update
rs.MoveNext

könnt ihr mir dabei helfen
  •  

MzKlMu

#1
Hallo,
die Schleife dürfte überflüssig sein. Das macht man mit einer Aktualisierungsabfrage.
Oder, Du nimmst ein Formular und bindest es an die Abfrage, dann sind die Werte auch direkt gleich in dwr Tabelle.
Ohnehin nimmt man für Datenänderungen fast immer ein Formular.

Das was Du nicht zeigst (....), wäre das Wichtigste.
Überhaupt ist es immer sinnvoll Code vollständig zu zeigen, statt zusammenhangslose Codeschnippsel.
Und für Codedarstellungen die Codetags des Forums benutzen.
Gruß
Klaus
  •  

jensgebken

#2
Option Compare Database

Private Sub Befehl3_Click()
Dim strSQL As String
Dim wert

Dim DB As dao.Database
Dim rs As dao.Recordset
Dim strDatei As String, strWhere As String
Dim objOutlook As Outlook.Application
Dim objOutlookMsg As Outlook.MailItem
Dim objOutlookRecip As Outlook.Recipient
Dim Betreff As String: Betreff = "Ihr Monatlicher Bericht"
Dim Nachricht As String, an As String, ATT1
Dim oApp As New Outlook.Application
Dim oEmail As Outlook.MailItem
Dim fileName As String, todayDate As String
   
   
ATT1 = "S:\test1.csv"
 'exportincsv
HöchsterWert = DMax("letztenummer", "Gutschriftnummer")
umeinserhöhenhöchsterwert:
HöchsterWert = HöchsterWert + 1

    Set DB = CurrentDb
    strSQL = "SELECT * FROM AbfrageEigentuemer"
    Set rs = DB.OpenRecordset(strSQL, dbOpenDynaset)
    Do Until rs.EOF
   
  Set objOutlook = CreateObject("Outlook.Application")
  Set objOutlookMsg = objOutlook.CreateItem(0)
   strDatei = "S:\Rechnung\" & HöchsterWert & "-" & rs.Fields("Objekt-Nr").Value & ".pdf"
 
        rsnr = rs.Fields("Reservierungs-Nr")
        mailadresse = rs.Fields("Email").Value
        iban = rs.Fields("Kontonummer").Value
        NameE = rs.Fields("Name").Value
       
        mailadresse = "jens@test.de" 'zum Testen
        strWhere = strSQL & " WHERE [Objekt-Nr] = '" & rs![Objekt-Nr] & "' and Anreisetag = " & Format(rs![Anreisetag], "\#yyyy-mm-dd\#")
        DoCmd.OpenReport "AbrechnungEigentuemer", acViewDesign
        Reports![AbrechnungEigentuemer].RecordSource = strWhere
        DoCmd.OpenReport "AbrechnungEigentuemer", acViewPreview, , strWhere, acWindowNormal
        DoCmd.OutputTo acOutputReport, "AbrechnungEigentuemer", acFormatPDF, strDatei, False
   

Set DBG = CurrentDb()


' Benutzerdaten
Set rsg = DBG.OpenRecordset("Gutschriftnummer", dbOpenDynaset)
 
    rsg.AddNew
        rsg!Reserierungsnummer = rsnr
        rsg!letztenummer = HöchsterWert
       
       
    rsg.Update
rsg.Close

DBG.Close
     
        fileName = strDatei
       
DoCmd.OutputTo acOutputReport, "AbrechnungEigentuemer", acFormatPDF, fileName, False

        DoCmd.Close acReport, "AbrechnungEigentuemer", acSaveNo


        wert = Date
        CurrentDb.Execute "Update Reservierungen Set abgerechnetam = Date(), abgerechnet='-1' Where [Anreisetag] = #" & Format(rs![Anreisetag], "yyyy-mm-dd") & "# and [Objekt-Nr] = '" & rs![Objekt-Nr] & "'"
     
     'update der gutscheinnummer in die Tabelle Reservierung
     CurrentDb.Execute "Update Reservierungen Set Gutschriftnummer =" & HöchsterWert & " where [Reservierungs-Nr] = " & rsnr

             
        rs.MoveNext
 

'Export report in same folder as db with date stamp



'Email the results of the report generated
Set oEmail = oApp.CreateItem(olMailItem)
With oEmail
    .Recipients.Add mailadresse
   .Subject = "Mietabrechnung "
    .Body = "Sehr geehrte Damen und Herren," & vbCrLf & vbCrLf & "im Anhang erhalten Sie die Abrechnung für Ihr Ferienhaus." & vbCrLf & "Wenn Sie Fragen zu der Abrechnung haben, wenden Sie sich bitte an Frau ...."
   
    .Attachments.Add fileName
    .Send
End With

MsgBox "Email successfully sent!", vbInformation, "EMAIL STATUS"
        GoTo umeinserhöhenhöchsterwert
    Loop
   
    rs.Close
    Set rs = Nothing

    Set DB = Nothing
 'Erstellung Mietabrechnung als datei
 Ablagedatum = Format(Now, "DD-MM-YYYY")
  'Abfrage ob Datei vorhanden - wenn ja, dnn um einen Wert erhöhen
startpruefungdatei:
pruefdatei = "S:\abrechnung\Mietabrechnung" & Ablagedatum & ".csv"
'pruefdatei = "C:\abrechnung\Mietabrechnung" & Ablagedatum & ".csv"
   'If Dir("C:\abrechnung\Mietabrechnung" & Ablagedatum & ".csv") <> "" Then
   If Dir("S:\abrechnung\Mietabrechnung" & Ablagedatum & ".csv") <> "" Then
MsgBox "Datei vorhanden"
zaehler = zaehler + 1
Ablagedatum = Ablagedatum & "-" & zaehler
GoTo startpruefungdatei


   
 

Else
End If
'DoCmd.TransferText acExportDelim, "Mietabrechnung2022", "Mietabrechnung", "C:\abrechnung\Mietabrechnung" & Ablagedatum & ".csv", False
DoCmd.TransferText acExportDelim, "Auszahlung", "Abfrage6", "S:\abrechnung\Mietabrechnung" & Ablagedatum & ".csv", False
'Hier schreibe ich in die Tab Reservierungen, den Abrechnungstag
Set DB = CurrentDb
    strSQL = "SELECT * FROM Reservierungen WHERE Gutschrift_erstellt_am IS NULL and Gutschriftnummer is not null"
    Set rs = DB.OpenRecordset(strSQL, dbOpenDynaset)
    CurrentDb.Execute ("UPDATE Reservierungen SET Gutschrift_erstellt_am= Date () WHERE Gutschrift_erstellt_am is null and Gutschriftnummer <>0")
    'CurrentDb.Execute "Update Reservierungen Set [Gutschrift_erstellt_am] = " & test & " where [Gutschrift_erstellt_am] is null "
  ' rs.Update
    rs.Close
    'rs.Update
    Set rs = Nothing

    Set DB = Nothing
   
End Sub
  •