' 注意：1.當使用Excle方式時(shí)，選擇記錄集時(shí)表名為 [工作表$]
' 例： ConnRS JDB, JRS, "select * from [Sheet1$]"
'===========================
'====API引用====
Public Declare Function SHFileOperation Lib "shell32.dll" Alias "SHFileOperationA" (lpFileOp As SHFILEOPSTRUCT) As Long
Public Type SHFILEOPSTRUCT
hwnd As Long
wFunc As Long
pFrom As String
pTo As String
fFlags As Long
fAnyOperationsAborted As Long
hNameMappings As Long
lpszProgressTitle As String
End Type
'====數據源變量====
Public JDB As New ADODB.Connection '----這個(gè) ADODB.Connection 用戶(hù)使用,作用域:全局----
Public JRS As New ADODB.Recordset '----這個(gè) ADODB.Recordset 用戶(hù)使用,作用域:全局----
Public JCMD As New ADODB.Command
'====SQL服務(wù)器變量====
Public JServerName As String '----SQL服務(wù)器名----
Public JUserID As String '----用戶(hù)名----
Public JPassword As String '----密碼----
Public JDefaultDB As String '----默認數據庫名----
'====自定義過(guò)程:設置SQL服務(wù)器變量====
' ----使用SQL方式接連前使用----
Public Sub SetSQLDef(ServerName As String, UserID As String, Password As String, DefaultDB As String)
JServerName = ServerName
JUserID = UserID
JPassword = Password
JDefaultDB = DefaultDB
End Sub
'====自定義函數:連接數據源====
' DBClass=1 無(wú)密碼的Access數據源連接，ConnStr=mdb文件的完整路徑。
' DBClass=2 SQL Server 方式連接，ConnStr沒(méi)有用
' 要使用SetSQLDef先設置SQL服務(wù)器變量
' DBClass=3 無(wú)密碼的Excle數據源連接，ConnStr=xls文件的完整路徑。
' 例：ConnDB JDB,3,App.Path & "\Temp.xls"
' DbClass=4 使用udl文件連接
' connstr 為udl文件的完整路徑
' Dbclass=5 使用txt/csv文件連接
' connstr 為csv文件的完整路徑，但不包括csv文件名
' 例：D:\CSVDB\test.csv
' ConnDB JDB,5,"C:\CSVDB\"
' ConnRS JDB, JRS, "select * from test.csv"
' DBClass=11 有密碼的Access數據源連接，ConnStr=mdb文件的完整路徑 & "*" & 密碼
' 例：ConnDB JDB, 11, App.Path & "\sysDB.mdb*ps123"
' 返回值為：連接成功=True；連接失敗=False
Public Function ConnDB(DBs As ADODB.Connection, DBClass As Long, Optional ByVal connstr As String) As Boolean
connstr = Trim(connstr)
If DBs.State = adStateOpen And Not IsEmpty(adStateOpen) Then DBs.Close
DBs.CursorLocation = adUseServer
Select Case DBClass
Case 1: DBs.Open "PROVIDER=Microsoft.jet.OLEDB.4.0;data source= " & connstr
Case 2: DBs.Open "Provider=SQLOLEDB.1;Password=" & JPassword & ";Persist Security Info=True;User ID=" & JUserID & ";Initial Catalog=" & JDefaultDB & ";Data Source=" & JServerName
Case 3:
With DBs
.Provider = "Microsoft.Jet.OLEDB.4.0"
.ConnectionString = "Data Source=" & connstr & ";Extended Properties=Excel 8.0;"
.Provider = "MSDASQL"
.ConnectionString = "Driver={Microsoft Excel Driver (*.xls)};DBQ=" & connstr & ";"
.CursorLocation = adUseClient
.Open
End With
Case 4:
With DBs
On Error GoTo ConnDBErrPro
.ConnectionString = "FILE NAME=" & connstr
.Open
End With
Case 5:
DBs.ConnectionString = "Driver={Microsoft Text Driver (*.txt; *.csv)};DefaultDir=" & connstr
DBs.Open
Case 6:
'JServerName = ServerName
'JUserID = UserID
'JPassword = Password
'JDefaultDB = DefaultDB
'DRIVER={MySQL ODBC 3.51 Driver};
DBs.ConnectionString = "Driver={sql server};uid=" & JUserID & ";pwd=" & JPassword & ";database=" & JDefaultDB & ";server=" & JServerName
DBs.Open
Case 11:
Dim temp As Integer
temp = InStr(connstr, "*")
DBs.Open "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & Left(connstr, temp - 1) & ";Persist Security Info=False;Jet OLEDB:database password=" & Right(connstr, Len(connstr) - temp)
Case Else:
End Select
ConnDBErrPro:
ConnDB = DBs.State = adStateOpen And Not IsEmpty(adStateOpen)
End Function
'====自定義函數:選擇記錄集（游標）====
' SQLStr SQL語(yǔ)句，一般為"select * from table"，可由自己的程序設計制定。
' 返回值為：連接成功=True；連接失敗=False
' 注意：當使用Excle方式時(shí)，選擇記錄集時(shí)表名為 [工作表$]
' 例: ConnRS JDB, JRS, "select * from [Sheet1$]"
Public Function ConnRS(DBs As ADODB.Connection, RSs As ADODB.Recordset, SQLstr As String) As Boolean
If RSs.State = adStateOpen And Not IsEmpty(adStateOpen) Then RSs.Close
RSs.Open SQLstr, DBs, adOpenKeyset, adLockPessimistic
' RSs.Open SQLstr, DBs, adOpenDynamic, adLockBatchOptimistic
ConnRS = RSs.State = adStateOpen And Not IsEmpty(adStateOpen)
End Function
'====自定義過(guò)程:關(guān)閉數據源====
Public Sub CloseDB(DBs As ADODB.Connection)
If DBs.State = adStateOpen And Not IsEmpty(adStateOpen) Then DBs.Close
End Sub
'====自定義過(guò)程:關(guān)閉記錄集（游標）====
Public Sub CloseRS(RSs As ADODB.Recordset)
If RSs.State = adStateOpen And Not IsEmpty(adStateOpen) Then RSs.Close
End Sub
'====自定義函數:新建/覆蓋UDL文件====
' 參數:
' UDLname 文件完整路徑
' Mode False:如果文件存在,不覆蓋./True:如果文件存在,覆蓋.
' CreateOpen 新建后打開(kāi)文件. False:不打開(kāi)/True:打開(kāi)
' 返回值: True:成功/False失敗
Public Function CreateUDL(UDLname As String, Mode As Boolean, CreateOpen As Boolean) As Boolean
On Error GoTo CreateUDLErrPro
Dim fs, a
If Right(UDLname, 4) <> ".udl" Then UDLname = UDLname & ".udl"
Set fs = CreateObject("Scripting.FileSystemObject")
Set a = fs.CreateTextFile(UDLname, Mode)
a.Close
CreateUDL = True
If CreateOpen Then
Dim ExecStr As String
ExecStr = "rundll32.exe " & App.Path & "\DLL\oledb32.dll,OpenDSLFile " & UDLname
Shell ExecStr
End If
CreateUDLErrPro:
Select Case Err.Number
Case 0:
Case 58:
CreateUDL = False
End Select
End Function
'====自定義過(guò)程:打開(kāi)UDL文件====
'
Public Sub OpenUDL(UDLname As String)
Dim ExecStr As String
ExecStr = "rundll32.exe " & App.Path & "\DLL\oledb32.dll,OpenDSLFile " & UDLname
Shell ExecStr
End Sub
'====自定義過(guò)程:刪除UDL文件====
Public Sub DeleteUDL(UDLname As String)
If LCase(Right(UDLname, 4)) = ".udl" Then
Dim result As Long, fileop As SHFILEOPSTRUCT
With fileop
.hwnd = 0
.wFunc = &H3
.pFrom = UDLname & vbNullChar & vbNullChar
.fFlags = &H40
End With
result = SHFileOperation(fileop)
End If
End Sub
