vbs操作数据库

'本函数创建一个数据库
Function CreateDB(filename)
Dim dbEnger
On Error Resume Next
set dbEnger=createobject("adox.catalog")
dbEnger.create("Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & filename)
Set dbEnger=Nothing
CreateDB=Err.number
End Function

'打开一个活动的连接
Function connect(provider)
Dim conn
On Error Resume Next
Set conn = createobject("adodb.connection")
conn.open provider
If Err Then
connect=Nothing
Else
Set connect=conn
End If
End Function

'执行SQL语句
Function execute(conn,sql)
Dim rs
Set rs = conn.execute(sql)
If Err Then
execute = Err.number
Else
Set execute = rs
End if
End Function

'显示错误信息
Sub showErr(errDes)
MsgBox errDes,vbCritical,"错误"
End Sub

'主函数,程序将从这里执行
Sub main
Dim dbpath
Dim errnum
Dim conn,rs,sql
dbpath = InputBox("请输入数据库路径","提示","c:\a.mdb")

errnum = CreateDB(dbpath)
If (errnum<>0) Then
showErr "创建数据库失败。" + vbCrLf + "请检查是否有相应的权限，或者数据库文件是否已存在。"
Exit Sub
End If

Set conn = connect("Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & dbpath)

sql = "CREATE TABLE [Account](ID Autoincrement PRIMARY KEY,[姓名] text(50),[电话] text(20),[QQ] text(12),[住址] text(100),[EMAIL] text(50))"
If (IsNumeric(execute(conn,sql))) Then
showErr "创建数据表失败。"
Exit Sub
End If

sql = "INSERT INTO [Account]([姓名],[电话],[QQ],[住址],[EMAIL]) VALUES('张三','010-*******','10000','中国','anbert@https://www.360docs.net/doc/9d4703614.html,')"
If (Not IsObject(execute(conn,sql))) Then
showErr "插入一条数据时失败。"
Exit Sub
End If

'以下语句往数据库中插入120条数据
Set rs = createobject("adodb.recordset")
rs.open "SELECT * FROM [Account]",conn,3,3
For i = 1 To 120
rs.AddNew
rs.Fields(1) = CStr(i)
rs.Fields(2) = CStr(i)
rs.Fields(3) = CStr(i)
rs.Fields(4) = CStr(i)
rs.Fields(5) = CStr(i)
rs.Update
Next
rs.close

sql = "DELETE FROM [Account] WHERE [ID]>50 AND [ID]<60"
If (Not IsObject(execute(conn,sql))) Then
showErr "删除ID号在50与60之间的数据时失败。"
Exit Sub
End If

sql = "UPDATE [Account] SET [姓名]='Anbert',[电话]='888888',[QQ]='1000',[住址]='XXX',[EMAIL]='anbert@https://www.360docs.net/doc/9d4703614.html,' WHERE [ID]=80"
If (Not IsObject(execute(conn,sql))) Then
showErr "更新ID号为80的数据时失败。"
Exit Sub
End If

sql = "SELECT COUNT(ID) AS num,MAX(ID) AS n FROM [Account]"
Set rs = execute(conn,sql)
If (Not IsObject(rs)) Then

showErr "查询数据库时失败。"
Exit Sub
Else
MsgBox "数据表Account统计" + vbCrLf + vbCrLf + "共有记录数量：" + CStr(rs("num")) + vbCrLf + "ID最大编号：" + CStr(rs("n")),vbInformation,"查询数据库"
End If
rs.close
Set rs=Nothing

MsgBox "全部操作成功!",vbInformation,"恭喜"

conn.close
Set conn=nothing
End Sub

'调用主函数开始执行程序
main