2009-11-06 12 views

Odpowiedz

6

Jak o:

Dim appAccess As Object 
''acTable=0 

Set appAccess = CreateObject("Access.Application") 
appAccess.OpenCurrentDatabase "C:\Docs\LTD.mdb" 

appAccess.DoCmd.Rename "NewTableName", 0, "OldTableName" 

appAccess.Quit 
Set appAccess = Nothing 
+1

Byłoby miło, gdyby twój kod został oczyszczony po sobie, nie sądzisz? –

+2

@ David W Fenton Miałem wrażenie, że jest to forum, na którym pomysły powinny wystarczyć, i że wystarczą nawet odpowiedzi jednolinijne. – Fionnuala

+1

@ David W Fenton, jeśli naprawdę sądzisz, że to jest takie ważne, edytuj odpowiedź i napraw to sam –

9

Oto przykład jednego z moich programów (który nadal jest w codziennym użyciu w firmie). Jest pobierany z programu vb6, ale także jest wykonywany w vba. Przetestowałem to, aby się upewnić.

W tym przykładzie mamy tabelę tymczasową o nazwie "mytable_tmp", która jest aktualizowana o nowe dane i chcielibyśmy ją zapisać w tabeli "mytable", zastępując ją.

Od edytora Excel VBA trzeba ustawić odwołanie do dwóch następujących bibliotekach Typ:

  • "Microsoft ActiveX Data Objects 2.8 Library"
  • „Microsoft ADO Ext 2,8 do DDL i. Zabezpieczenia "

Pierwsza dotyczy przestrzeni nazw ADODB, a druga przestrzeni nazw ADOX. (Może masz wcześniejszą wersję MDAC podobną do wersji 2.5 lub wcześniejszej, to też powinno działać).

Private Sub RenameTable() 
Dim cn   As New ADODB.Connection 
Dim cat  As ADOX.Catalog 
Const sDBFile As String = "c:\et\dbtest.mdb" 

    On Error GoTo ErrH 

    With cn 
     .Provider = "Microsoft.Jet.OLEDB.4.0" 
     .Mode = adModeShareDenyNone 
     .Properties("User ID") = "admin" 
     .Properties("Password") = "" 
     .Open sDBFile 
    End With 

    Set cat = New ADOX.Catalog 
    cat.ActiveConnection = cn 
    cat.Tables("mytable").Name = "mytable_old" 
    cat.Tables("mytable_tmp").Name = "mytable" 
    cat.Tables("mytable_old").Name = "mytable_tmp" 

ExitHere: 
    If Not cn Is Nothing Then 
     If Not cn.State = adStateClosed Then cn.Close 
     Set cn = Nothing 
    End If 
    Set cat = Nothing 
    Exit Sub 

ErrH: 
Dim sMsg As String 
    sMsg = "Massive problem over here man." 
    sMsg = sMsg & vbCrLf & "Description : " & cn.Errors.Item(0).Description 
    MsgBox sMsg, vbExclamation 
    GoTo ExitHere 
End Sub 

Mając nadzieję być pomocnym.

+1

Wydaje mi się, że jedyną wartością tego długowiecznego kodu w trzech liniach kodu Remou jest, gdy nie masz zainstalowanego programu Access . –

+0

Daje także możliwość wykonywania więcej niż zwykłej kopii w tym samym kodzie - a kto wie, użytkownik Excela może nie mieć dostępu do Access. Wciąż jednak muszę przyznać, że wygląd Remou jest bardziej użyteczny. – mavnn

+0

;) Jak śmiesz uwzględniać obsługę błędów i komunikaty użytkownika. I o co chodzi w tym formatowaniu! (Dużo śmieszniej, jeśli robisz to w głosie Stewiego). +1 – JeffO

0

Oto drobna alternatywa dla powyższego kodu Remou. Używam funkcji powłoki, aby otworzyć bazę danych, której potrzebuję, a następnie funkcję GetObject, aby uzyskać dostęp do jej właściwości i metod. Zalety robienia tego w ten sposób są następujące: 1) Można wybrać sposób otwierania okna aplikacji Access. Dla moich celów chcę, żeby to było ukryte. 2) Mam zainstalowany zarówno program Access 2003, jak i 2007, a metoda Remou powoduje otwarcie 2003, czego nie chcę. Moja metoda (jak sądzę) otwiera plik w dowolnej wersji, z której korzystałby system Access, gdyby użytkownik dwukrotnie go kliknął.

Wadą jest to, że należy upewnić się, że baza danych jest otwarta przed próbą manipulowania nią. Używam prostego podprogramu oczekiwania, aby sobie z tym poradzić, ale są bardziej wyrafinowane rzeczy, które możesz zrobić.

Sub Rename() 
    Dim ObjAccess As Object, MDB_Address As String, TaskID As Integer 

    MDB_Address = "C:\example.mdb" 

    TaskID = Shell("msaccess.exe " & Chr(34) & MDB_Address & Chr(34), vbHide) 
    Call Wait 
    Set ObjAccess = GetObject(MDB_Address) 
    ObjAccess.DoCmd.Rename "NewTableName", 0, "OldTableName" 
    ObjAccess.Quit 
    Set ObjAccess = Nothing 

End Sub 

Sub Wait() 

    Dim nHour As Date, nMinute As Date, nSecond As Date, waitTime As Date 

    nHour = Hour(Now()) 
    nMinute = Minute(Now()) 
    nSecond = Second(Now()) + 5 
    waitTime = TimeSerial(nHour, nMinute, nSecond) 
    Application.Wait waitTime 

End Sub 
Powiązane problemy