求一个 VB 连接SQL SERVER数据库里表的 实例！谢谢

Question

如题所述

Answer 1

Private Sub Command1_Click()

' Dim excel_app As excel.Application
' Dim excel_sheet As excel.Sheets
Dim excel_app As Object
Dim excel_sheet As Object
Dim rs As ADODB.Recordset
Dim strsql As String
Dim pubconn As ADODB.Connection
Dim exfieldA As String
Dim exfieldB As String
Dim exfieldC As String
Dim exfieldD As String

'打开数据库
Set rs = New ADODB.Recordset
Set pubconn = New ADODB.Connection
pubconn = "Provider=SQLOLEDB.1;Persist Security Info=False;User ID=sa;Initial Catalog=aaa;Data Source=(local)"
pubconn.Open

Set excel_app = CreateObject("excel.application") 'excel对象
Set excel_app = New Excel.Application
' excel_app.Visible = True
excel_app.Workbooks.Open FileName:="D:\astroboy\河南生税务支持系统\实现\字典\111.xls"
' excel_app.Worksheets(Combo1.ListIndex + 1).Activate
If Val(excel_app.Application.Version) >= 8 Then '检查excel文件的版本
Set excel_sheet = excel_app.ActiveSheet

Else
Set excel_sheet = excel_app
End If

'''创建sql表格
Dim crtstrsql As String
Dim exceltst As String

exceltst = Text1.Text

exfieldA = Trim$(excel_sheet.Cells(1, 1))
exfieldB = Trim$(excel_sheet.Cells(1, 2))
exfieldC = Trim$(excel_sheet.Cells(1, 3))
exfieldD = Trim$(excel_sheet.Cells(1, 4))

crtstrsql = ""
crtstrsql = crtstrsql & "create table " & exceltst & "(" & vbCrLf
crtstrsql = crtstrsql & exfieldA & " char(50) null," & vbCrLf
crtstrsql = crtstrsql & exfieldB & " char(6) null," & vbCrLf
crtstrsql = crtstrsql & exfieldC & " datetime null," & vbCrLf
crtstrsql = crtstrsql & exfieldD & " datetime null)"

pubconn.Execute crtstrsql

Dim new_value1 As String
Dim new_value2 As String
Dim new_value3 As String

Row = 2
Do
new_value = Trim$(excel_sheet.Cells(Row, 1)) '读取excel工作者第一列数据
new_value1 = Trim$(excel_sheet.Cells(Row, 2))
If excel_sheet.Cells(Row, 3) = "" Then
new_value2 = ""
Else
new_value2 = CDate(excel_sheet.Cells(Row, 3) & "1月")
End If
If excel_sheet.Cells(Row, 4) = "" Then
new_value3 = ""
Else
new_value3 = CDate(excel_sheet.Cells(Row, 4) & "1月")
End If

If Len(new_value) = 0 And Len(new_value1) = 0 Then Exit Do
'将这一值插入SQL数据库
strsql = "insert into " & exceltst & "(" & exfieldA & "," & exfieldB & "," & exfieldC & "," & exfieldD & ") values('" & new_value & "','" & new_value1 & "','" & new_value2 & "','" & new_value3 & "')"
pubconn.Execute strsql

Row = Row + 1 '读取下一行数据
Loop
MsgBox "传输数据完成！", vbOKOnly, "完成！"
pubconn.Close
excel_app.Quit

Set rs = Nothing
Set pubconn = Nothing
Set excel_app = Nothing
Set excel_sheet = Nothing

End Sub
或参考以下
EXCEL文件要设置固定格式，还要设置命名范围，然后才可以导入
大致思路如下：
'// 设置打开 EXCEL 文件的连接字符串
strConn = "Provider=Microsoft.Jet.OLEDB.4.0;" & _
"Data Source=excel文件名;Extended Properties=Excel 8.0"

'// 以记录集的形式打开 Excel 文件，adoConn 为 ADODB.Connection 对象
adoConn.Open strConn
'// 将数据插入到指定的表中（以ODBC的方式打开SQL数据库）
strSQL = "INSERT INTO [odbc;Driver={SQL Server};Server=服务器IP;Database=数据库;UID=用户名;PWD=密码].SQL中的表名 SELECT EXCEL中的字段 FROM EXCEL工作表名"
'// 执行导入语句
adoConn.Execute strSQL, , adExecuteNoRecords