在VBA里SQL登录可以定义为函数吗？

killer05

在论坛里学习的时候发现太多次重复调用连接SQL 所以求教下 vba连接SQL可以定义为函数模块吗 需要的时候就调用
Dim cn As Object    '定义数据链接对象 ，保存连接数据库信息
Set cn = CreateObject("ADODB.Connection")  '创建数据链接对象
Dim strCn As String '字符串变量
ser = Sheet1.Range("B1").Value  '定义服务器的名称
yhm = Sheet1.Range("B2").Value '定义服务器用户名
  mm = Sheet1.Range("B3").Value '定义服务器的登录密码
  da = Sheet1.Range("B4").Value '定义服务器的数据库
strCn = "Provider=sqloledb;" _
         & "Server=" & ser & ";" _
         & "Database=" & da & ";" _
         & "Uid=" & yhm & ";" _
         & "Pwd=" & mm & ";"   '定义数据库链接字符串

killer05

我自己挖的坑 我自己填吧 希望碰到类似的朋友 少点折腾
先定义个函数
例如

1. Public Function SQLConnect(strServer As String, strDatabase As String, _
   
2.     strUid As String, strPwd As String) As Boolean
   
3.     'strServer 服务器名称
   
4.     'strDatabase 数据库 库名
   
5.     'strUid SQL访问用户名
   
6.     'strPwd SQL访问密码
   
7.     Set cn = CreateObject("ADODB.Connection")  '创建数据链接对象
   
8.     strCn = "Provider=sqloledb;Server=" & strServer & ";Database=" & _
   
9.         strDatabase & ";Uid=" & strUid & ";Pwd=" & strPwd & ";"    '定义数据库链接字符串
   
10.         cn.Open strCn
    
11.     End Function

复制代码

然后再引用

1. Sub 连接SQL()
   
2. SQLConnect Sheet1.Range("B1").Value, _
   
3.            Sheet1.Range("B4").Value, _
   
4.            Sheet1.Range("B2").Value, _
   
5.            Sheet1.Range("B3").Value  '连接数据库
   
6. 'Sever =服务器名称；Database =数据库名称,Uid =sa ； Pwd = 以sa身份登录数据库的密码
   
7. On Error GoTo aa
   
8. If cn <> "" Then
   
9. MsgBox "数据库连接成功", vbInformation, "SQL"
   
10. cn.Close
    
11. Exit Sub
    
12. End If
    
13. aa: MsgBox "数据库连接失败", vbInformation, "SQL"
    
14. End Sub

复制代码

SQLConnect这个就是第一段引用的 避免那么多段代码了

jiminyanyan

支持一下。。。。。

opiona

查添改删 都可，参考70楼：http://club.excelhome.net/thread-859194-1-1.html

killer05

opiona 发表于 2018-8-4 18:31
查添改删 都可，参考70楼：http://club.excelhome.net/thread-859194-1-1.html

先感谢 受教了 因为是新手难免会有很多疑问 习惯搜索，搜索不到答案 再发帖问的。 看了推荐帖子自定义函数研究中

killer05

1. Public cn  As New ADODB.Connection
   
2. Public rs, StrSQL, strCn, mydata As String
   
3. Public Function Sql_Connet(ByVal strServerName As String, ByVal strDatabaseName As String, ByVal strUid As String, ByVal strPwd As String) As Boolean
   
4. On Error GoTo Err_Set
   
5. cn = "Driver={SQL Server};Server=" & strServerName & ";Database=" & strDatabaseName & ";Uid=" & strUid & ";Pwd=" & strPwd
   
6. cn.ConnectionTimeout = 5
   
7. cn.Open
   
8. Exit Function
   
9. Err_Set:
   
10. [h5] = Err.Number
    
11. [h6] = Err.Description
    
12. MsgBox Err.Description
    
13. Err.Clear
    
14. End Function

复制代码

用自定义函数 这个代码又变短了如下代码忘记注释了 B1表格是服务器 B4是数据库 B2是服务器用户，B3是服务器登录密码放在表格sheet5
要引用ADO2.8要不然自定义函数找不到对象

引用ADO

要是给别人用别人不知道引用ADO那就在自定义函数里添加下列语句
Set cn = CreateObject("ADODB.Connection")
Set rs = CreateObject("ADODB.recordset")

1. Sub 连接SQL()
   
2. With Sheet5
   
3. Call Sql_Connet(.[B1], .[B4], .[B2], .[B3])
   
4. End With
   
5. cn.Close
   
6. Set rs = Nothing
   
7. Set cn = Nothing
   
8. End Sub

复制代码

除去三行释放的代码 引用的是别人代码 借花献佛了