Die Community zu .NET und Classic VB.
Menü

VB 5/6-Tipp 0555: Mittels ADO Namen einer Tabelle ändern

 von 

Beschreibung 

Hin und wieder ist es nötig, ganze Tabellen umzubenennen. Leider gibt es dafür keine vorgefertigte Funktion. Dieser Tipp zeigt, wie es trotzdem geht!

Schwierigkeitsgrad:

Schwierigkeitsgrad 2

Verwendete API-Aufrufe:

keine

Download:

Download des Beispielprojektes [2,63 KB]

'Dieser Quellcode stammt von http://www.activevb.de
'und kann frei verwendet werden. Für eventuelle Schäden
'wird nicht gehaftet.

'Um Fehler oder Fragen zu klären, nutzen Sie bitte unser Forum.
'Ansonsten viel Spaß und Erfolg mit diesem Source!

'------------- Anfang Projektdatei Projekt1.vbp -------------
' Es muss ein Verweis auf 'Microsoft ActiveX Data Objects 2.0 Library' gesetzt werden.
' Es muss ein Verweis auf 'Microsoft ADO Ext. 2.7 for DDL and Security' gesetzt werden.

'--------- Anfang Formular "Form1" alias Form1.frm  ---------
' Steuerelement: Listen-Steuerelement "List1"
'
'---------------------------------------------------------
'  einbinden über Projekt --> Verweise
'
'  Microsoft ActiveX Data Objects 2.x
'  Microsoft ADO Ext 2.x for DLL and Security
'---------------------------------------------------------

Option Explicit
 
Dim Cn As ADODB.Connection
Dim CnX As ADOX.Catalog
 
Private Sub Form_Load()
 
   Dim strPathToDB As String
   Dim i As Long
 
      Set Cn = New ADODB.Connection
      Set CnX = New ADOX.Catalog
      
      strPathToDB = "nordwind.mdb"
      
      With Cn
         .CursorLocation = adUseClient
         .Mode = adModeShareDenyNone
         .Provider = "Microsoft.Jet.OLEDB.4.0"
         .ConnectionString = strPathToDB
         .Open
      End With
      
      CnX.ActiveConnection = Cn
      
      List1.Clear
      For i = 0 To CnX.Tables.Count - 1
         If CnX.Tables(i).Type = "TABLE" Then
            List1.AddItem CnX.Tables(i).Name
         End If
      Next
      
      
End Sub
 
Private Sub List1_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
 
   Dim i As Long
   Dim s As String
   Dim TableName As String
   Dim NewTableName As String
   Dim Fehler As String
   
      If Button <> 2 Then
         Exit Sub
      End If
      
      i = List1.ListIndex
      If i < 0 Then
         Exit Sub
      End If
      
      TableName = List1.List(i)
      s = "Tabellenname der Tabelle " & TableName & _
          " ändern in ... "
      NewTableName = Trim(InputBox(s, "Table Rename", TableName))
      
      If UCase(NewTableName) = UCase(TableName) Then
         Exit Sub
      End If
      
      'keine Eingabe
      If Len(NewTableName) = 0 Then
         Exit Sub
      End If
      
      'Tabellenname ändern
      If Not ADO_TableRename(Cn, TableName, NewTableName, Fehler) Then
         MsgBox Fehler, vbCritical
         Exit Sub
      End If
      
      'Catalog neu auslesen
      CnX.ActiveConnection = Nothing
      CnX.ActiveConnection = Cn
      
      'List neu aufbauen
      List1.Clear
      For i = 0 To CnX.Tables.Count - 1
         If CnX.Tables(i).Type = "TABLE" Then
            List1.AddItem CnX.Tables(i).Name
         End If
      Next
End Sub
 
Public Function ADO_TableRename(CnCn As ADODB.Connection, _
                                OldName As String, _
                                NewName As String, _
                                Optional Fehler As String) As Boolean
'eine Tabelle unter ADO Renamen
   Dim tmpCnCat As ADOX.Catalog
   Dim i As Long
   Dim gefunden As Boolean
 
      Fehler = ""
      On Error Goto Abbruch
      
      Set tmpCnCat = New ADOX.Catalog
      tmpCnCat.ActiveConnection = CnCn
      
      'Tables auslesen
         With tmpCnCat
         For i = 0 To .Tables.Count - 1
            If .Tables(i).Type = "TABLE" Then
               If UCase(OldName) = UCase(.Tables(i).Name) Then
                  'gefunden, ändern
                  .Tables(i).Name = NewName
                  gefunden = True
                  Exit For
               End If
            End If
         Next
      End With
      If gefunden Then
         ADO_TableRename = True
      Else
         Fehler = "Table " & OldName & " not Found"
      End If
Abbruch:
      If Not tmpCnCat Is Nothing Then
         Set tmpCnCat = Nothing
      End If
      
      If Err.Number <> 0 Then
         Fehler = "Fehler " & Err.Number & vbCrLf & _
                  Err.Description
      End If
      Err.Clear
End Function


'---------- Ende Formular "Form1" alias Form1.frm  ----------
'-------------- Ende Projektdatei Projekt1.vbp --------------

Tipp-Kompatibilität:

Windows/VB-VersionWin32sWin95Win98WinMEWinNT4Win2000WinXP
VB4
VB5
VB6

Hat dieser Tipp auf Ihrem Betriebsystem und mit Ihrer VB-Version funktioniert?

Ja, funktioniert!

Nein, funktioniert nicht bei mir!

VB-Version:

Windows-Version:

Ihre Meinung  

Falls Sie Fragen zu diesem Artikel haben oder Ihre Erfahrung mit anderen Nutzern austauschen möchten, dann teilen Sie uns diese bitte in einem der unten vorhandenen Themen oder über einen neuen Beitrag mit. Hierzu können sie einfach einen Beitrag in einem zum Thema passenden Forum anlegen, welcher automatisch mit dieser Seite verknüpft wird.