vbs脚本操作数据库实例|vbs建立创建链接access数据库|vbs建access表字段脚本

'本函数创建一个数据库
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-8888888','10000','中国','anbert@56.com')"
     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@56.com' 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