[分享] excel 在sql-server里建立数据库和表

lin_x

附件中有一个excel文件，里面有宏，可以连接数据库，建立数据表，和一个连接查询的例子。是我给人做的演示例子，拿来分享一下。看的好，注意跟帖哦,可以运行里面的main宏就是主程序。要求装有sql-server2000或更高版本

aBbgcrtJ.rar (26.27 KB, 下载次数: 185)

2008-9-14 13:00 上传

点击文件名下载附件
[分享] excel 在sql-server里建立数据库和表

[此贴子已经被作者于2008-9-14 13:00:13编辑过]

jilijun

打开附件提示：丢失了 Visual Basic 项目

请LZ把源代码贴上来吧，谢谢！

lin_x

Option Explicit
Private cnn As ADODB.Connection
Private rst As ADODB.Recordset
Private cnnstr As String
Private sDatabase As String

Private Sub mShowError(sFunction As String, sError As String)
     Call gShowError("主模块", sFunction, sError)
End Sub
Private Sub InitData()
  Dim str1 As String
  Dim str2 As String
  Dim str3 As String
  Dim str4 As String
  Dim str5 As String
  Dim str As String
 
  str1 = "'张三'"
  str2 = "'李四'"
  str3 = "'童利'"
  str4 = "'佟野'"
  str5 = "'王方'"
 
  Set cnn = New ADODB.Connection
  Set rst = New ADODB.Recordset
 
  sDatabase = txtDatabase.Text
  cnnstr = "Driver={SQL Server};Server=" & txtServer.Text & ";Database=" & sDatabase & ";Uid=" & txtUser.Text & ";Pwd=" & txtPWD.Text & ";"
  On Error Resume Next
  cnn.Open cnnstr
  If err.Number <> 0 Then
    sDatabase = ""
    cnnstr = "Driver={SQL Server};Server=" & txtServer.Text & ";Database=" & sDatabase & ";Uid=" & txtUser.Text & ";Pwd=" & txtPWD.Text & ";"
    cnn.Open cnnstr
    Set rst = cnn.Execute("create database " & txtDatabase.Text)
    MsgBox "数据库 " & txtDatabase.Text & " 已创建成功"
  End If
  sDatabase = txtDatabase.Text
  cnn.DefaultDatabase = sDatabase
  MsgBox "数据库 " & txtDatabase.Text & " 已连接成功"
  cnn.Execute ("drop table 学生成绩表")
  cnn.Execute ("drop table 学生信息表")
  On Error GoTo ErrorHandler
 
  Set rst = cnn.Execute("create Table 学生成绩表 (考试号 varchar(5), 姓名 varchar(10), 语文成绩 float, 数学成绩 float, 外语成绩 float)")
  MsgBox "学生成绩表 已创建成功"
 
  rst.Open "insert into 学生成绩表 (考试号,姓名,语文成绩,数学成绩,外语成绩) values ('001'," & str1 & ",88,95,77)", cnn
  rst.Open "insert into 学生成绩表 (考试号,姓名,语文成绩,数学成绩,外语成绩) values ('002'," & str2 & ",96,84,85)", cnn
  rst.Open "insert into 学生成绩表 (考试号,姓名,语文成绩,数学成绩,外语成绩) values ('003'," & str3 & ",75,40,69)", cnn
  rst.Open "insert into 学生成绩表 (考试号,姓名,语文成绩,数学成绩,外语成绩) values ('004'," & str4 & ",60,79,59)", cnn
  MsgBox "学生成绩表 数据已创建成功"
 
  Set rst = cnn.Execute("create table 学生信息表 (姓名 varchar(10),性别 varchar(2), 出生日期 varchar(10), 年龄 int, 联系地址 varchar(20))")
  MsgBox "学生信息表 已创建成功"
 
  rst.Open "insert into 学生信息表 (姓名,性别,出生日期,年龄,联系地址) values (" & str1 & ",'男','5/3/1980',28,'abcdef')", cnn
  rst.Open "insert into 学生信息表 (姓名,性别,出生日期,年龄,联系地址) values (" & str2 & ",'女','5/31/1986',22,'bcdefg')", cnn
  rst.Open "insert into 学生信息表 (姓名,性别,出生日期,年龄,联系地址) values (" & str3 & ",'男','7/3/1984',24,'cdefgh')", cnn
  rst.Open "insert into 学生信息表 (姓名,性别,出生日期,年龄,联系地址) values (" & str4 & ",'女','3/3/1985',25,'defghi')", cnn
  rst.Open "insert into 学生信息表 (姓名,性别,出生日期,年龄,联系地址) values (" & str5 & ",'女','3/3/1985',25,'defghi')", cnn
 
  MsgBox "学生信息表 数据已创建成功"
 
  Exit Sub
ErrorHandler:
  Call mShowError("test", err.Description)
  Call btnExit_Click
End Sub

Private Sub btnExit_Click()
  
   If Not cnn Is Nothing Then
      cnn.Close
      cnnstr = "Driver={SQL Server};Server=" & txtServer.Text & ";Database=;Uid=" & txtUser.Text & ";Pwd=" & txtPWD.Text & ";"
      cnn.Open cnnstr
      cnn.Execute ("drop database " & sDatabase)
      cnn.Close
      Set cnn = Nothing
      Set rst = Nothing
   End If
   Unload Me
End Sub

Private Sub btnOK_Click()
   If txtServer.Text <> "" And txtDatabase.Text <> "" Then
       btnExit.Enabled = False
       Call InitData
       btnOK.Enabled = False
       btnSelect.Enabled = True
       btnExit.Enabled = True
   Else
       MsgBox "请输入服务器和数据库名"
   End If
End Sub

Private Sub btnSelect_Click()
    Dim sex As String
    Dim mathsAver As Double
    Dim str As String
    Dim i As Long
   
    MsgBox "按性别排的数学平均"
    str = "性别   数学平均成绩" & vbCrLf
    If rst.State = 0 Then
       rst.Open "select 学生信息表.性别 性别,avg(学生成绩表.数学成绩) 数学平均成绩 from 学生信息表, 学生成绩表 where 学生信息表.姓名 = 学生成绩表.姓名 group by 学生信息表.性别", cnn
    End If
    rst.MoveFirst
    Do While Not rst.EOF
        sex = rst.Fields.Item("性别").Value
        mathsAver = rst.Fields.Item("数学平均成绩").Value
        str = str & sex & "   " & mathsAver & vbCrLf
        rst.MoveNext
    Loop
    MsgBox str
   
End Sub

Private Sub UserForm_Initialize()
    Me.btnSelect.Enabled = False
End Sub

Private Sub UserForm_QueryClose(Cancel As Integer, CloseMode As Integer)
    Call btnExit_Click
End Sub

zez

谢谢分享