|
|
吾爱游客
发表于 2023-9-12 11:18
1、申请ID：doitzhangjl
2、个人邮箱：88388768@qq.com
3、原创技术文章：
文章名：【VBA模块】连接MSSQL数据库类模块功能
[Visual Basic] 纯文本查看 复制代码
#新建一个类模块clsMSSQL
#以下代码放在clsMSSQL类模块中
Dim cnn, rst, strCnn$, arrTemp #定义类模块中使用的变量，cnn为链接本身对象，rst为记录集对象，arrTemp为数组，用于转存获取到的记录集中的数据
Private strServerIP$, strServerPort$, strdbUsername$, strdbPassword$, booDebugFlag As Boolean #定义数据库需要设置的属性值，包括IP、端口、用户名、密码等
#设置mssql链接的各个属性值
Public Property Let serverIP(ByVal strLetServerIP As String)
strServerIP = Trim(strLetServerIP)
End Property
Public Property Let serverPort(ByVal strLetServerPort As String)
strServerPort = Trim(strLetServerPort)
End Property
Public Property Let dbUsername(ByVal strLetdbUsername As String)
strdbUsername = Trim(strLetdbUsername)
End Property
Public Property Let dbPassword(ByVal strLetdbPassword As String)
strdbPassword = Trim(strLetdbPassword)
End Property
Public Property Let debugFlag(ByVal strLetbooDebug As Boolean)
booDebugFlag = strLetbooDebug
End Property
#打开数据库链接的方法openCnn
Public Sub openCnn()
On Error GoTo errHandle
If booDebugFlag = False Then
strCnn = "Provider=SQLOLEDB;Server=" & strServerIP & "," & strServerPort & ";Uid=" & strdbUsername & ";Pwd=" & strdbPassword & ";Persist Security Info=false"
Else
strCnn = "Provider=SQLOLEDB;Server=" & strServerIP & ";Uid=" & strdbUsername & ";Pwd=" & strdbPassword & ";Persist Security Info=false"
End If
cnn.Open strCnn
Exit Sub
errHandle:
MsgBox Err.Number & ": " & Err.Description
End Sub
#非查询操作时，使用executeNoQuery进行更新、写入等操作
Public Function executeNoQuery(ByVal strSQL As String)
On Error GoTo errHandle
cnn.Execute (strSQL)
executeNoQuery = True
Exit Function
errHandle:
executeNoQuery = False
MsgBox Err.Number & ": " & Err.Description
End Function
Public Property Get latestQueryData()
latestQueryData = arrTemp
End Property
#查询数据，并获取到数组中。
Public Function executeQuery(ByVal strSQL As String, Optional ByVal strName As Boolean = True)
Dim i As Long, j As Long
On Error GoTo errHandle
' Debug.Print strSQL
Set rst = CreateObject("ADODB.Recordset")
rst.CursorLocation = adUseClient
rst.Open strSQL, cnn, 1, 3
If strName = True Then
ReDim arrTemp(0 To rst.RecordCount, 0 To rst.Fields.Count - 1)
For j = 0 To rst.Fields.Count - 1
arrTemp(0, j) = rst.Fields(j).Name
Next j
For i = 0 To rst.RecordCount - 1
For j = 0 To rst.Fields.Count - 1
arrTemp(i + 1, j) = rst.Fields(j).Value
Next j
rst.MoveNext
Next i
Else
If rst.RecordCount >= 1 Then
ReDim arrTemp(1 To rst.RecordCount, 1 To rst.Fields.Count)
For i = 1 To rst.RecordCount
For j = 0 To rst.Fields.Count - 1
arrTemp(i, j + 1) = rst.Fields(j).Value
Next j
rst.MoveNext
Next i
Else
ReDim arrTemp(1 To 1, 1 To 1)
End If
End If
executeQuery = arrTemp
rst.Close
Set rst = Nothing
Exit Function
errHandle:
executeQuery = False
rst.Close
Set rst = Nothing
MsgBox Err.Number & ": " & Err.Description
End Function
#判断是否存在数据
Public Function executeRstExit(ByVal strSQL As String)
On Error GoTo errHandle
Set rst = CreateObject("ADODB.Recordset")
rst.CursorLocation = adUseClient
rst.Open strSQL, cnn, 1, 3
If rst.RecordCount = 0 Then
executeRstExit = False
Else
executeRstExit = True
End If
rst.Close
Set rst = Nothing
Exit Function
errHandle:
executeRstExit = False
rst.Close
Set rst = Nothing
MsgBox Err.Number & ": " & Err.Description
End Function
#初始化类
Private Sub Class_Initialize()
Set cnn = CreateObject("ADODB.Connection")
End Sub
#释放对象
Private Sub Class_Terminate()
cnn.Close
Set cnn = Nothing
End Sub
#调用操作，代码放在模块中，或事件中
sub connectmssql()
Set cMssql = New clsMSSQL
If booDebug Then cMssql.serverIP = "" Else cMssql.serverIP = ""
cMssql.serverPort = ""
cMssql.dbUsername = ""
cMssql.dbPassword = ""
cMssql.debugFlag = False
Call cMssql.openCnn
end sub
|
|
|
发帖前要善用【论坛搜索】功能，那里可能会有你要找的答案或者已经有人发布过相同内容了，请勿重复发帖。 |
|
|
|
|
|
|
