Question

怎么通过VB访问SQL Server数据库

我想把Excel中的数据导入到SQL Server中，通过Visual Basic语言实现，请高手帮忙，先谢了
另外，需要安装SQL Server客户端之类的软件吗？VB中还要安装什么控件吗？谢谢各位了

Answer 1

要连接SQL数据库有两种方法用ADODC或ADO.
方法一: （ADODC)
首先须引用Projects-Components-Microsoft ADO Data Controls 6.0 (OLEDB).
之后在表单设置ADODC控件。然后Form_Load()输入以下代码：

Private Sub Form_Load()
ADODC1.ConnectionString = "Provider=SQLOLEDB;Password=密码;Persist Security Info=False;User ID=用户名;Initial Catalog=数据库名;Data Source=服务器名"

ADODC1.CommandType = adCmdText
ADODC1.RecordSource = "select * from 表格名称"
ADODC1.Refresh
End Sub

方法二: (ADO)

'首先须引用Projects-References-Microsoft Active X Data Objects 2.0 Library.

'*注意以下两段须写在程式最上面（Gerenal一般）中。

Dim cn As New ADODB.Connection
Dim rs As New ADODB.Recordset
Dim SQL As String

'然后在Form_Load()输入以下代码：
Private Sub Form_Load()
cn.ConnectionString = "Provider=SQLOLEDB;Password=密码;Persist Security Info=False;User ID=用户名;Initial Catalog=数据库名;Data Source=服务器名"
cn.Open

If rs.State = adStateOpen Then rs.Close
rs.CursorLocation = adUseClient
SQL = "select * from 表格名"
rs.Open Trim$(SQL), cn, adOpenKeyset, adLockPessimistic
End Sub

Answer 2

分真高，所以比较多人来。
各位大大应该直接写个连接function出来，把各种连接方式一一展现，对楼主比较有用。 也便于后续调用

Answer 3

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

Answer 4

Option Explicit
Private conConnection As ADODB.Connection
Public rct As New ADODB.Recordset
Public ServerName As String
Public DBName As String

'连接到数据库
Public Function connectToServer() As Boolean
On Error GoTo ON_ERROR
Call CloseConnect
Set conConnection = New ADODB.Connection
conConnection.ConnectionString = "driver={sqlserver};Uid=sa;pwd=;" & _
"DataBase=" & DBName & ";server=" & ServerName & ";"
conConnection.ConnectionTimeout = 30
conConnection.Open
connectToServer = True
Exit Function
ON_ERROR:
MsgBox "错误描述：" & Err.Description & vbCrLf & "错误代码：" & Err.Number, vbCritical + vbOKOnly, "打开数据库错误"
connectToServer = False
End Function

'类初始化
Private Sub Class_Initialize()
Set conConnection = New ADODB.Connection
End Sub

'类实例销毁
Private Sub Class_Terminate()
Call CloseConnect
End Sub

'断开数据库的连接
Private Function CloseConnect() As Boolean
On Error Resume Next
If conConnection.State = adStateOpen Then
conConnection.Close
End If
Set rct = Nothing
Set conConnection = Nothing
CloseConnect = True
End Function

'获得NorthWind数据库里表Customers的数据
Public Function GetCustomersRecords() As Boolean
On Error GoTo ON_ERROR

Set rct = conConnection.Execute("SELECT * FROM tb_charge")
If rct.EOF = True And rct.BOF = True Then
GetCustomersRecords = False
Exit Function
End If

Exit Function

ON_ERROR:
MsgBox "错误描述：" & Err.Description & vbCrLf & "错误代码：" & Err.Number, vbCritical + vbOKOnly, "错误"
Err.Clear
GetCustomersRecords = False
End Function

偷的，不知道有用没。我自己也去试下