有什么技巧 可以快速创建Access数据库表
我要大量的创建Access类型的数据表
但是 手工创建很麻烦 我想 有没有 编写一个像 CreateXXX.sql 那样的语句
一次性执行就 ok啦
请教各位啦
我的信箱是weigs@sina.com
问题点数：50、回复次数：3Top
1 楼lumine（源点）回复于 2000-10-16 17:19:00 得分 40
没有问题，这是我曾经做过的一个建表程序
<<<<<<<<<<<<<< code >>>>>>>>>>>>>>>>>>>>
Private Sub Command1_Click()
Me.Hide
End
End Sub
Private Sub Form_Initialize()
Dim intResponse As Integer
Dim lRetValue As Long
Dim lResult As Long
Dim lKeyID As Long
Dim SubKey As String
Dim BufSize As Long
Dim KeyValue As String
'REGKEY = "SOFTWARE\" & COMPANY_NAME & "\" & COMPANY_PRODUCT & "\" & "Setting"
REGKEY = "Software\VB and VBA Program Settings\" & COMPANY_PRODUCT & "\Setting"
frmPath.Show 1
'lRetValue = RegCreateKey(HKEY_LOCAL_MACHINE, REGKEY, lKeyID)
DSN = GetSetting("NDDatabase", "Settings", "DSN", "")
'
'lRetValue = RegCreateKey(HKEY_CURRENT_USER, REGKEY, lKeyID)
'If lRetValue = 0 Then
' SubKey = "DSN"
' lRetValue = RegQueryValueEx(lKeyID, SubKey, 0&, REG_SZ, 0&, BufSize)
' If BufSize < 2 Then
' KeyValue = ""
' lRetValue = RegSetValueEx(lKeyID, SubKey, 0&, REG_SZ, ByVal KeyValue, Len(KeyValue) + 1)
' Else
' KeyValue = String(BufSize + 1, " ")
' lRetValue = RegQueryValueEx(lKeyID, SubKey, 0&, REG_SZ, ByVal KeyValue, BufSize)
' KeyValue = Left$(KeyValue, BufSize - 1)
' 'Text1.Text = KeyValue
' End If
'End If
DSN = Trim(KeyValue)
If DSN <> "" Then
intResponse = MsgBox("您已经安装过此软件，是否继续？", vbYesNo, "提示")
If intResponse = vbNo Then
End
End If
Else
DSN = DSNInit1 & ServerName & DSNInit2
'DSN = DSNModule
End If
'ServerName = GetSerName(DSN)
ServerName = GetNameOfComputer
DSNI = DSNTemp1 & ServerName & DSNTemp2
If ServerName <> "" Then
intResponse = MsgBox("您现在的所连接的服务器名为" & UCase(ServerName) & _
"是否更改?", vbYesNo, "提示")
If intResponse = vbNo Then
Else
frmServer.Text1.Text = ServerName
frmServer.Text1.SelLength = Len(ServerName)
frmServer.Text1.SelStart = 0
frmServer.Show 1
If frmServer.Tag = "F" Then
DSN = DSNInit1 & ServerName & DSNInit2
'RetValue = RegCreateKey(HKEY_CURRENT_USER, REGKEY, KeyId)
End If
End If
End If
'KeyValue = DSN
'RetValue = RegSetValueEx(lKeyID, "DSN", 0&, REG_SZ, ByVal KeyValue, Len(KeyValue) + 1)
SaveSetting "NDDatabase", "Settings", "DSN", DSN
Set conn = CreateObject("ADODB.Connection")
conn.ConnectionString = DSNI
conn.CursorLocation = adUseClient
'On Error GoTo ErrHandle
conn.Open
CreateDatabase
conn.Close
conn.ConnectionString = DSN
conn.CursorLocation = adUseClient
'On Error GoTo ErrHandle
conn.Open
CreateTABLE
Exit Sub
ErrHandle:
If Err.Number = -2147467259 Then
MsgBox "SQL Server 没有开始服务! " & vbCr & "请确认开启服务后再安装...", , "错误"
End
End If
End Sub
Private Function GetDSNServer(DSN) As String
Dim i As Integer
Dim iLen As Integer
iLen = Len(Trim(DSN))
For i = iLen To 0 Step -1
If Mid(DSN, i, 1) = "=" Then
Exit For
End If
Next i
GetDSNServer = Mid(DSN, i + 1)
End Function
Public Function ExecuteSQL(SQLStatement) As Boolean
Dim comm As ADODB.Command
Set comm = New ADODB.Command
ExecuteSQL = False
myErrNumber = 0
On Error GoTo ErrHandle
comm.ActiveConnection = conn
comm.CommandText = SQLStatement
comm.CommandType = adCmdText
comm.Execute
ExecuteSQL = True
Exit Function
ErrHandle:
myErrNumber = Err.Number
End Function
Private Function CreateTABLE() As Long
Dim SQL As String
Dim Result As Boolean
Dim intResponse As Integer
SQL = "CREATE TABLE [dbo].[DirTree] ( " & _
"[删除否] [bit] NOT NULL ," & _
"[描述] [nvarchar] (255) NULL ," & _
"[标题] [nvarchar] (255) NULL ," & _
"[主键] [nvarchar] (50) NULL ," & _
"[父键] [nvarchar] (50) NULL ," & _
"[分类] [nvarchar] (255) NULL ," & _
"[状态] [smallint] NULL ," & _
"[备份键] [nvarchar] (50) NULL ," & _
"[所有者] [nvarchar] (50) NULL ," & _
"[属性] [int] NULL" & _
") ON [PRIMARY]"
Result = ExecuteSQL(SQL)
If Result = False Then
If myErrNumber = -2147217900 Then
intResponse = MsgBox("库中已存在需要的表,是否继续?", vbYesNo, "提示")
If intResponse = vbNo Then
Else
End If
End If
End If
SQL = "CREATE TABLE [dbo].[Material] ( " & _
"[删除否] [bit] NOT NULL ," & _
"[标题] [nvarchar] (255) NULL ," & _
"[主键] [nvarchar] (50) NOT NULL ," & _
"[父键] [nvarchar] (50) NULL ," & _
"[父备份键] [nvarchar] (50) NULL ," & _
"[外部键] [nvarchar] (50) NULL ," & _
"[外备份键] [nvarchar] (50) NULL ," & _
"[类别] [nvarchar] (50) NULL ," & _
"[GUID] [nvarchar] (50) NULL ," & _
"[文件类型] [int] NULL ," & _
"[描述] [nvarchar] (255) NULL ," & _
"[文件大小] [int] NULL ," & _
"[日期] [smalldatetime] NULL ," & _
"[所有者] [nvarchar] (50) NULL ," & _
"[状态] [smallint] NULL ," & _
"[根键] [nvarchar] (50) NULL ," & _
"[属性] [int] NULL" & _
")"
Result = ExecuteSQL(SQL)
If Result = False Then
If myErrNumber = -2147217900 Then
intResponse = MsgBox("库中已存在需要的表,是否继续?", vbYesNo, "提示")
If intResponse = vbNo Then
Else
End If
End If
End If
SQL = "CREATE TABLE [dbo].[NDTemp] ( " & _
"[删除否] [bit] NOT NULL ," & _
"[标题] [nvarchar] (255) NULL ," & _
"[主键] [nvarchar] (50) NOT NULL ," & _
"[父键] [nvarchar] (50) NULL ," & _
"[父备份键] [nvarchar] (50) NULL ," & _
"[外部键] [nvarchar] (50) NULL ," & _
"[外备份键] [nvarchar] (50) NULL ," & _
"[类别] [nvarchar] (50) NULL ," & _
"[GUID] [nvarchar] (50) NULL ," & _
"[文件类型] [int] NULL ," & _
"[描述] [nvarchar] (255) NULL ," & _
"[文件大小] [int] NULL ," & _
"[日期] [smalldatetime] NULL ," & _
"[所有者] [nvarchar] (50) NULL ," & _
"[状态] [smallint] NULL ," & _
"[根键] [nvarchar] (50) NULL ," & _
"[属性] [int] NULL" & _
")"
Result = ExecuteSQL(SQL)
If Result = False Then
If myErrNumber = -2147217900 Then
intResponse = MsgBox("库中已存在需要的表,是否继续?", vbYesNo, "提示")
If intResponse = vbNo Then
Else
End If
End If
End If
SQL = "CREATE TABLE [dbo].[PhysicFile] (" & _
"[标题] [nvarchar] (50) NULL ," & _
"[主键] [nvarchar] (50) NULL ," & _
"[链接次数] [smallint] NULL ," & _
"[服务器名] [nvarchar] (50) NULL ," & _
"[日期] [smalldatetime] NULL ," & _
"[文件类型] [int] NULL ," & _
"[文件大小] [int] NULL" & _
") ON [PRIMARY]"
Result = ExecuteSQL(SQL)
If Result = False Then
If myErrNumber = -2147217900 Then
intResponse = MsgBox("库中已存在需要的表,是否继续?", vbYesNo, "提示")
If intResponse = vbNo Then
Else
End If
End If
End If
SQL = "CREATE TABLE [dbo].[UserLicense] ( " & _
"[ID] [int] IDENTITY (1, 1) NOT NULL ," & _
"[用户名] [nvarchar] (50) NOT NULL ," & _
"[权限] [int] NOT NULL ," & _
"[密码] [nvarchar] (50) NULL ," & _
"[描述] [nvarchar] (250) NULL" & _
") ON [PRIMARY]"
Result = ExecuteSQL(SQL)
SQL = "INSERT INTO UserLicense (用户名,权限,密码) values ('Admin',3,'hh')"
Result = ExecuteSQL(SQL)
If Result = False Then
If myErrNumber = -2147217900 Then
intResponse = MsgBox("库中已存在需要的表,是否继续?", vbYesNo, "提示")
If intResponse = vbNo Then
Else
End If
End If
End If
End Function
Private Function CreateDatabase()
Dim SQL As String
SQL = "DROP DATABASE NDDatabase"
ExecuteSQL SQL
SQL = "CREATE DATABASE NDDatabase" & _
" ON PRIMARY " & _
" (NAME = NDDatabase_dat," & _
" SIZE = 1MB," & _
" FILENAME = '" & INST_PATH & "\" & "NDData" & ".MDF')" & _
" LOG ON " & _
" (NAME = 'NDDatabase_log'," & _
" SIZE = 1MB," & _
" FILENAME = '" & INST_PATH & "\" & "NDDataLog.LDF')"
lResult = ExecuteSQL(SQL)
If myErrNumber = -2147217900 Then
MsgBox "当前库正在使用! 建库错误,", , "错误"
End
End If
End Function
Private Function GetSerName(sSrcStr As String) As String
Dim strTmp As String
Dim lLen As Long
Dim lKeyLen As Long
Dim sResult As String
Dim sTitleStr As String
Dim i As Long
i = 5
Label:
strTmp = Trim(GetBetweenStr(sSrcStr, ";", i))
lLen = Len(strTmp)
lKeyLen = Len(DSNSerTitle)
sTitleStr = Left(strTmp, lKeyLen)
If sTitleStr = DSNSerTitle Then
sResult = Right(strTmp, lLen - lKeyLen)
Else
i = i + 1
GoTo Label
End If
GetSerName = sResult
End Function
Private Function GetNameOfComputer() As String
Dim ComputerName As String
Dim ltmpSize As Long
Dim i As Long
ComputerName = Space(50)
Label:
lResult = GetComputerName(ComputerName, ltmpSize)
If lResult <> 0 Then
ComputerName = Left(ComputerName, ltmpSize)
'MsgBox ComputerName
GetNameOfComputer = ComputerName
Else
i = i + 1
If i > 10 Then
GetNameOfComputer = ""
End If
GoTo Label
End If
End Function
Top
2 楼lumine（源点）回复于 2000-10-16 17:22:00 得分 10
那是在SQL Server中建表，要是在ACCESS中建表，就改一下DSNTop
3 楼weity（魏广新）回复于 2000-10-18 13:07:00 得分 0
我想 lumine 误会了
我要在access97 用vba 编写应用程序
现在有很多的表 我有er图 我想生成CreateTable的查询 然后执行就可以建表
不过 我没有办法 快速生成Sql 呵呵
我该怎么办？
有相关工具吗？？Top
相关问题
关键词
得分解答快速导航
相关链接
广告也精彩
反馈
