Private Sub BUmbenennen_Click() DoCmd.Hourglass True DoCmd.DoMenuItem acFormBar, acRecordsMenu, acSaveRecord, , acMenuVer70 SortenKuerzelUmbenennen DoCmd.Hourglass False DoCmd.Close Forms!FSorten.Requery End Sub Private Sub Form_Open(Cancel As Integer) TempTabelleAnlegen Forms!FSortenkuerzelUmbenennen.RecordSource = "xTempSortenkuerzelumbenennen" Requery End Sub Sub TempTabelleAnlegen() Dim db1 As Database Dim rs1 As Recordset Dim rs2 As Recordset Set db1 = CurrentDb If TableExists("xTempSortenkuerzelUmbenennen") Then db1.Execute ("drop table xTempSortenkuerzelUmbenennen") End If db1.Execute ("Create table xTempSortenkuerzelUmbenennen (SNRAlt TEXT, BezeichnungAlt TEXT, kgprohaalt DOUBLE,typalt TEXT, SNRNeu TEXT, BezeichnungNeu TEXT, kgprohaneu DOUBLE, typneu TEXT)") db1.Execute ("delete * from xTempSortenkuerzelumbenennen") Set rs1 = db1.OpenRecordset("SELECT * FROM TSorten") Set rs2 = db1.OpenRecordset("xTempSortenkuerzelumbenennen") While Not rs1.EOF rs2.AddNew rs2!SNRAlt = rs1!SNR rs2!SNRNeu = rs1!SNR rs2!BezeichnungAlt = rs1!Bezeichnung rs2!Bezeichnungneu = rs1!Bezeichnung rs2!kgprohaneu = rs1!KgProHa rs2!kgprohaalt = rs1!KgProHa rs2!Typalt = rs1!Typ rs2!Typneu = rs1!Typ rs2.Update rs1.MoveNext Wend rs1.Close rs2.Close End Sub Sub SortenKuerzelUmbenennen() Dim db1 As Database Dim rs1 As Recordset Dim rs2 As Recordset Set db1 = CurrentDb Set rs1 = db1.OpenRecordset("SELECT * from xTempSortenkuerzelUmbenennen ORDER BY SNRAlt") '1. Alle Sorten von alt auf neu mit n als Präfix While Not rs1.EOF 'TAuszahlungSorten db1.Execute ("UPDATE TAuszahlungSorten SET SNR='n" + rs1!SNRNeu + "' WHERE SNR='" + Format(rs1!SNRAlt) + "'") 'TFlaechenbindungen db1.Execute ("UPDATE TFlaechenbindungen SET SNR='n" + rs1!SNRNeu + "' WHERE SNR='" + Format(rs1!SNRAlt) + "'") 'TLieferungen db1.Execute ("UPDATE TLieferungen SET SNR='n" + rs1!SNRNeu + "' WHERE SNR='" + Format(rs1!SNRAlt) + "'") 'TSorten db1.Execute ("UPDATE TSorten SET SNR='n" + rs1!SNRNeu + "',kgproha=" + Format(rs1!kgprohaneu) + " WHERE SNR='" + Format(rs1!SNRAlt) + "'") rs1.MoveNext Wend rs1.Close '2. Bei allen Sorten den Präfix n entfernen Set rs1 = db1.OpenRecordset("SELECT DISTINCT SNRNeu from xTempSortenkuerzelUmbenennen ORDER BY SNRNeu") db1.Execute ("DELETE * FROM TSorten") Set rs2 = db1.OpenRecordset("TSorten") While Not rs1.EOF 'TAuszahlungSorten db1.Execute ("UPDATE TAuszahlungSorten SET SNR='" + rs1!SNRNeu + "' WHERE SNR='n" + rs1!SNRNeu + "'") 'TFlaechenbindungen db1.Execute ("UPDATE TFlaechenbindungen SET SNR='" + rs1!SNRNeu + "' WHERE SNR='n" + rs1!SNRNeu + "'") 'TLieferungen db1.Execute ("UPDATE TLieferungen SET SNR='" + rs1!SNRNeu + "' WHERE SNR='n" + rs1!SNRNeu + "'") 'TSorten ' db1.Execute ("UPDATE TSorten SET SNR='" + rs1!SNRneu + "' WHERE SNR='n" + rs1!SNRneu + "'") rs2.AddNew rs2!SNR = rs1!SNRNeu rs2!KgProHa = DFirst("kgprohaneu", "xTempSortenkuerzelUmbenennen", "SNRNeu='" + rs1!SNRNeu + "'") rs2!Bezeichnung = DFirst("Bezeichnungneu", "xTempSortenkuerzelUmbenennen", "SNRNeu='" + rs1!SNRNeu + "'") rs2!Typ = DFirst("typneu", "xTempSortenkuerzelUmbenennen", "SNRNeu='" + rs1!SNRNeu + "'") rs2.Update rs1.MoveNext Wend rs1.Close End Sub 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