VBA, Create New Access Database From Excel

Euler

Mod
Thành viên BQT
Bài viết này sẽ hướng dẫn cách tạo file acces tự động bằng VBA trên excel.
1. Tạo file access tự động bằng macro
Cách 1:
Ưu điểm, chạy code tự động, tiện lợi khi chia sẻ, không cần thiết định gì.
Mã:
Sub Example1()
'the path to create the new access database
Dim strPath As String
'an Access object
Dim objAccess As Object

strPath = "D:\VBA\NewDB"
Set objAccess = CreateObject("Access.Application")
Call objAccess.NewCurrentDatabase(strPath)
objAccess.Quit
End Sub
Kết quả:
Bạn cần đăng nhập để thấy hình ảnh


Cách 2: Cần thiết định trên file excel vì vậy hơi bất tiện.
Cách thiết định:
Bạn cần đăng nhập để thấy hình ảnh

Mã:
Sub Example2()
'the path to create the new access database
Dim strPath As String
'an Access object
Dim objAccess As Access.Application

strPath = "D:\VBA\NewDB2"
Set objAccess = New Access.Application
Call objAccess.NewCurrentDatabase(strPath)
objAccess.Quit
End Sub
2. Tạo file access tự động, đồng thời tạo newtable trong file access.
Mã:
Sub Example3()
'the path to create the new access database
Dim strPath As String
'an Access object
Dim objAccess As Access.Application

strPath = "D:\VBA\NewDB3"
Set objAccess = New Access.Application
Call objAccess.NewCurrentDatabase(strPath)
'create table
objAccess.CurrentProject.Connection.Execute ( _
"Create Table tuhocvba_table")
End Sub
Kết quả:
Bạn cần đăng nhập để thấy hình ảnh


Bạn có thể download file excel đã chứa những đoạn code trên.
File :
 

Euler

Mod
Thành viên BQT
Như vậy chúng ta thấy rằng với phương thức như sau thì không cần thiết định trong file excel:
Mã:
Set objAccess = CreateObject("Access.Application")
Ngược lại với phương thức sau thì cần phải thiết định trong excel:
Mã:
Set objAccess = New Access.Application
Trong đó cách thiết định là:
Bạn cần đăng nhập để thấy hình ảnh
Áp dụng hai phương thức này ta có hai cách để tạo field.
VBA Add Fields to External Access Database (Automation)
Giả thiết rằng ta đã có file access NewDB3.accdb và trong file này đã có table là tuhocvba_table .
Bây giờ ta sẽ thêm field vào table này:
Mã:
Sub Example1()
'an Access object
Dim objAccess As Object
Set objAccess = CreateObject("Access.Application")
'open access database
Call objAccess.OpenCurrentDatabase( _
"D:\VBA\NewDB3.accdb")
'add field
objAccess.CurrentProject.Connection.Execute ( _
"ALTER TABLE tuhocvba_table ADD COLUMN NewField CHAR")
End Sub
Hoặc với code sau nhưng yêu cầu phải thiết định trước trong excel như đã nói ở trên.
Mã:
Sub Example2()
'an Access object 
Dim objAccess As Access.Application
Set objAccess = New Access.Application
'open access database 
Call objAccess.OpenCurrentDatabase( _
"D:\VBA\NewDB3.accdb")
objAccess.CurrentProject.Connection.Execute ( _
"ALTER TABLE MyTable1 ADD COLUMN NewField CHAR")
End Sub
Kết quả là:
Bạn cần đăng nhập để thấy hình ảnh

Ta hãy chú ý tới câu lệnh chèn field:
Mã:
ALTER TABLE MyTable1 ADD COLUMN NewField CHAR
 

tuhocvba

Administrator
Thành viên BQT
Ở trên, kiểu dữ liệu CHAR ta được Short text.
Ngoài ra các kiểu thông dụng khác hay dùng:
Microsoft Access Field Data Type Reference
CHARShort Text
MemoShort Text/Win 10 Office 2016: Long Text Admin tuhocvba da kiem tra
TEXTLong Text
TIMEDate/Time
VarBinaryBinary
SingleNumber
BITYES/NO
Nguồn tham khảo:



 

Euler

Mod
Thành viên BQT
3. Kiểm tra Table đã tồn tại trong file access hay chưa?
Check If Table Exists in External Access Database, VBA Automation


Mặc dù chúng ta chủ động tạo mới file access và chủ động tạo table, vì vậy hoàn toàn kiểm soát được Table nào được tạo, đã tồn tại hay chưa.
Tuy nhiên dù sao đi nữa, về mặt logic, chúng ta vẫn nên có bước kiểm tra. Bài viết này sẽ giới thiệu code kiểm tra một Table có tồn tại trong file access hay không?
Bài viết được tham khảo ở đây, có chỉnh sửa code vì lúc lấy code về chương trình không có chạy được hihi.
Nguồn:
Mã:
https://software-solutions-online.com/vba-automation-check-if-table-exists-in-external-access-database/
Mã:
Function CheckExists1(ByVal strTable As String) As Boolean
'an Access object
Dim objAccess As Object
'connection string to access database
Dim strConnection As String
'catalog object
Dim objCatalog As Object
'connection object
Dim cnn As Object
Dim i As Integer
Dim intRow As Integer
CheckExists1 = False
Set objAccess = CreateObject("Access.Application")
'open access database
Call objAccess.OpenCurrentDatabase( _
"C:\VBA\NewDB3.accdb")
'get the connection string
strConnection = objAccess.CurrentProject.Connection.ConnectionString
'close the access project
objAccess.Quit
'create a connection object
Set cnn = CreateObject("ADODB.Connection")
'assign the connnection string to the connection object
cnn.ConnectionString = strConnection
'open the adodb connection object
cnn.Open
'create a catalog object
Set objCatalog = CreateObject("ADOX.catalog")
'connect catalog object to database
objCatalog.ActiveConnection = cnn
'loop through the tables in the catalog object
intRow = 1
For i = 0 To objCatalog.Tables.Count - 1
'check if the table is a user defined table
    If objCatalog.Tables.Item(i).Type = "TABLE" Then
        If objCatalog.Tables.Item(i).Name = strTable Then
            CheckExists1 = True
            Exit Function
        End If
    End If
Next i


End Function

Sub Test1()
    If CheckExists1("tuhocvba_table2") = True Then
        MsgBox ("The table exists")
    Else
        MsgBox ("The table does NOT exists")
    End If
End Sub
Tất nhiên trên excel cần thiết định các thư viện sau:
Bạn cần đăng nhập để thấy hình ảnh


Kết quả chạy kiểm tra được như sau:
Bạn cần đăng nhập để thấy hình ảnh
 

tuhocvba

Administrator
Thành viên BQT
Liệt kê tất cả các table có trong database:
Mã:
Sub ketnoivalaydulieu()
    Dim cnn As Object: Dim rst As Object
    Dim lsSQL As String
    Dim linkdb  As String
    Dim arr As Variant
    Dim strConnection As String
    Dim objCatalog As Object
    Dim i As Integer
    Dim intRow As Integer
    
    Set cnn = CreateObject("ADODB.Connection")
    Set rst = CreateObject("ADODB.Recordset")
    linkdb = "C:\Users\jpnfriend.net\Desktop\VBA\NewDB33.mdb"
    With cnn
        .Provider = "Microsoft.ACE.OLEDB.12.0" 'Access truoc day la: "Microsoft Jet 4.0 OLE DB Provider"
        .ConnectionString = linkdb
        .Properties("Jet OLEDB:Database Password") = "1234"
        .Open
    End With
    
'    cnn.ConnectionString = strConnection
    
    Set objCatalog = CreateObject("ADOX.catalog")
    objCatalog.ActiveConnection = cnn
    intRow = 1
    For i = 0 To objCatalog.Tables.Count - 1
    'check if the table is a user defined table
        If objCatalog.Tables.Item(i).Type = "TABLE" Then
            MsgBox objCatalog.Tables.Item(i).Name
            
        End If
    Next i
    
    
    cnn.Close
    Set cnn = Nothing
End Sub
 

Euler

Mod
Thành viên BQT
Liệt kê tất cả các field có trong một table:
Mã:
Sub ketnoivalaydulieu()
    Dim cnn As Object: Dim rst As Object
    Dim lsSQL As String
    Dim linkdb  As String
    Dim arr As Variant
    Set cnn = CreateObject("ADODB.Connection")
    Set rst = CreateObject("ADODB.Recordset")
    linkdb = "C:\Users\jpnfriend.net\Desktop\VBA\NewDB33.mdb"
    With cnn
        .Provider = "Microsoft.ACE.OLEDB.12.0" 'Access truoc day la: "Microsoft Jet 4.0 OLE DB Provider"
        .ConnectionString = linkdb
        .Properties("Jet OLEDB:Database Password") = "1234"
        .Open
    End With
    
    lsSQL = "SELECT * " & _
            "FROM Test"
            
    rst.Open lsSQL, cnn
    For Each fName In rst.Fields
        Debug.Print fName.Name
    Next fName
    
    Set rst = Nothing
    cnn.Close
    Set cnn = Nothing
End Sub
Kết quả:
Bạn cần đăng nhập để thấy hình ảnh


Nguồn:
 
Top