添加到@HansUp的出色答案中，您可以隐藏IDENTITY列，同时使用sql公开格式化的列VIEW：然后可以撤消对表的特权，以便用户使用VIEW和不“查看”表，例如：demo：
复制+粘贴到任何VBA模块中，无需引用也不需要Access UI /对象模型，可以在temp文件夹中创建一个新的mdb，例如，使用Excel：
Sub YourView2()
On Error Resume Next
Kill Environ$("temp") & "\DropMe.mdb"
On Error GoTo 0
Dim cat
Set cat = CreateObject("ADOX.Catalog")
With cat
.Create _
"Provider=Microsoft.Jet.OLEDB.4.0;" & _
"Data Source=" & _
Environ$("temp") & "\DropMe.mdb"
With .ActiveConnection
Dim sql As String
sql = _
"CREATE TABLE YourTable ( " & _
"ID INTEGER IDENTITY(1, 1) NOT NULL UNIQUE, " & _
"data_col VARCHAR(20) NOT NULL);"
.Execute sql
sql = _
"CREATE VIEW YourView AS " & _
"SELECT FORMAT$(ID, '0000') & 'A' AS formatted_ID, " & vbCr & _
" data_col " & vbCr & _
" FROM YourTable;"
.Execute sql
sql = _
"INSERT INTO YourView (data_col) VALUES ('one');"
.Execute sql
sql = _
"INSERT INTO YourView (data_col) VALUES ('day');"
.Execute sql
sql = _
"INSERT INTO YourView (data_col) VALUES ('when');"
.Execute sql
sql = "SELECT * FROM YourView;"
Dim rs
Set rs = .Execute(sql)
Msg@R_805_2419@ rs.GetString
End With
Set .ActiveConnection = Nothing
End With
End Sub
我认为，如果您包含DDL GRANT / REVOKE示例来管理特权，那么它会更好。
这是完成此操作的更新代码：
Sub YourView2()
On Error Resume Next
Kill Environ$("temp") & "\DropMe.mdb"
Kill Environ$("temp") & "\DropMeToo.mdw"
On Error GoTo 0
' Create workgroup and db
Dim cat As ADOX.Catalog
Set cat = CreateObject("ADOX.Catalog")
With cat
.Create _
"Provider=Microsoft.Jet.OLEDB.4.0;" & _
"Jet OLEDB:Engine Type=4;" & _
"Data Source=" & _
Environ$("temp") & "\DropMeToo.mdw;" & _
"Jet OLEDB:Create System Database=-1"
.Create _
"Provider=Microsoft.Jet.OLEDB.4.0;" & _
"Jet OLEDB:Engine Type=4;" & _
"Data Source=" & _
Environ$("temp") & "\DropMe.mdb;" & _
"Jet OLEDB:System Database=" & _
Environ$("temp") & "\DropMeToo.mdw;"
' Add table with data and user with privileges
With .ActiveConnection
Dim sql As String
sql = _
"CREATE TABLE YourTable ( " & _
"ID INTEGER IDENTITY(1, 1) NOT NULL UNIQUE, " & _
"data_col VARCHAR(20) NOT NULL);"
.Execute sql
sql = _
"CREATE VIEW YourView AS " & _
"SELECT FORMAT$(ID, '0000') & 'A' AS formatted_ID, " & vbCr & _
" data_col " & vbCr & _
" FROM YourTable WITH OWNERACCESS OPTION;"
.Execute sql
.Execute "CREATE USER onedaywhen pwd Chri5tma5;"
.Execute "GRANT ALL PRIVILEGES ON YourView TO onedaywhen;"
.Execute "REVOKE ALL PRIVILEGES ON YourTable FROM onedaywhen;"
End With
End With
' Test user can connect
Dim con As ADODB.Connection
Set con = New ADODB.Connection
With con
.ConnectionString = _
"Provider=Microsoft.Jet.OLEDB.4.0;" & _
"Jet OLEDB:Engine Type=4;" & _
"Data Source=" & _
Environ$("temp") & "\DropMe.mdb;" & _
"Jet OLEDB:System Database=" & _
Environ$("temp") & "\DropMeToo.mdw;" & _
"User ID=onedaywhen;Password=pwd;"
.Open
On Error Resume Next
' Attempt to insert to table (no privileges)
sql = _
"INSERT INTO YourTable (data_col) VALUES ('one');"
.Execute sql
If Err.Number <> 0 Then
Msg@R_805_2419@ _
Err.Number & ": " & _
Err.Description & _
" (" & Err.source & ")"
End If
On Error GoTo 0
Dim rs
On Error Resume Next
' Attempt to read table (no privileges)
sql = _
"SELECT * FROM YourTable;"
Set rs = .Execute(sql)
If Err.Number <> 0 Then
Msg@R_805_2419@ _
Err.Number & ": " & _
Err.Description & _
" (" & Err.source & ")"
End If
On Error GoTo 0
' From here, work only with VIEW
sql = _
"INSERT INTO YourView (data_col) VALUES ('one');"
.Execute sql
sql = _
"INSERT INTO YourView (data_col) VALUES ('day');"
.Execute sql
sql = _
"INSERT INTO YourView (data_col) VALUES ('when');"
.Execute sql
sql = "SELECT * FROM YourView;"
Set rs = .Execute(sql)
Msg@R_805_2419@ rs.GetString
Set con = Nothing
End With
End Sub
602392714
清零编程群