جرب الشيفرة هذه .....
On Error Resume Next
Dim strSQL3, strSQL1, strSQL2 As String
Dim B As New Access.Application
Set B = CreateObject("Access.Application")
B.OpenCurrentDatabase "D:\New folder (2)\Database.accdb"
strSQL1 = "CREATE TABLE asrt_tbl " _
& "(Code INTEGER , cosmotic CHAR(50), available BIT , " _
& "supplier CHAR(50),Unit CHAR(30), unitprice Double ,Quantity CHAR(30) , " _
& "CONSTRAINT asrt_tblConstraint UNIQUE " _
& "(Code, cosmotic, available, supplier, Unit, unitprice, Quantity ));"
strSQL2 = "CREATE TABLE asrt_tbl1 " _
& "(Code INTEGER , cosmotic CHAR(50), available BIT , " _
& "supplier CHAR(50),Unit CHAR(30), unitprice Double ,Quantity CHAR(30) , " _
& "CONSTRAINT asrt_tblConstraint UNIQUE " _
& "(Code, cosmotic, available, supplier, Unit, unitprice, Quantity ));"
strSQL3 = "CREATE TABLE asrt_tbl2 " _
& "(Code INTEGER , cosmotic CHAR(50), available BIT , " _
& "supplier CHAR(50),Unit CHAR(30), unitprice Double ,Quantity CHAR(30) , " _
& "CONSTRAINT asrt_tblConstraint UNIQUE " _
& "(Code, cosmotic, available, supplier, Unit, unitprice, Quantity ));"
B.DoCmd.RunSQL strSQL1
B.DoCmd.RunSQL strSQL2
B.DoCmd.RunSQL strSQL3
B.CloseCurrentDatabase
Set B = Nothing
B.Quit
MsgBox Space(20) & "تمت العملية بنجاح.." & Space(20), msgstyle, "للمعلومية"