-
Notifications
You must be signed in to change notification settings - Fork 1
/
Copy pathadodb.bas
93 lines (69 loc) · 3.24 KB
/
adodb.bas
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
'===============================================================================================================
' ADODB VBA
' Última atualização - 06/06/2022
'http://www.heritage-tech.net/908/inserting-data-into-mysql-from-excel-using-vba/
'Enable reference: "Microsoft ActiveX Data Objects 6.0 Library"
'Firebird ODBC driver - https://firebirdsql.org/en/odbc-driver/
'Firebird connection example:
' driver={Firebird/InterBase(r) driver};dbname=192.168.0.1/3050:C:\database\database.fdb;client=c:\firebird\fbclient.dll;user=sysdba;password=masterkey
Option Explicit
Global adoConnection As ADODB.connection
Global rs As ADODB.Recordset
'===============================================================================================================
Public Function ConnectDatabase(vConnectionString As String)
On Error GoTo ErrorHandler
'Dim adoConnection As String
Set adoConnection = New ADODB.connection
'Configuração Global Conexão
adoConnection.ConnectionString = vConnectionString
adoConnection.Open
Exit Function
ErrorHandler:
MsgBox "Error number: " & Err.Number - vbObjectError & vbNewLine & Err.Description & vbNewLine & vbNewLine & "Contate o suporte técnico de TI!", vbCritical, "Mensagem de erro"
Set adoConnection = Nothing
End Function
'===============================================================================================================
'Function CloseDatabase
Public Function CloseDatabase()
adoConnection.Close
Set adoConnection = Nothing
End Function
'===============================================================================================================
'Function Query
Public Function Query(ByVal sql_query As String, ByVal vSheetName As String, Optional ByVal vShowHeader As Boolean = True, Optional ByVal vStartCell As String = "A1")
Dim Plan As Worksheet
Dim i As Integer, vRowIni As Integer, vColIni As Integer
Set Plan = fnGetSheetFromCodeName(vSheetName)
Set rs = New ADODB.Recordset
rs.CursorLocation = adUseClient
rs.Open sql_query, adoConnection, adOpenDynamic, adLockOptimistic
With Plan
vColIni = .Range(vStartCell).Column
vRowIni = .Range(vStartCell).Row
'Get header name from columns
If (vShowHeader = True) Then
For i = vColIni To vColIni + rs.Fields.Count - 1
.Cells(vRowIni, i) = rs.Fields(i - vColIni).Name
Next i
vRowIni = vRowIni + 1
End If
'Copy result from recorset to sheet
.Cells(vRowIni, vColIni).CopyFromRecordset rs
End With
'Close recorset
rs.Close
End Function
'===============================================================================================================
'Function Execute
Public Function ExecuteSQL(sql_query As String)
On Error GoTo ErrorHandler
adoConnection.BeginTrans
Set rs = adoConnection.Execute(sql_query)
adoConnection.CommitTrans
Set rs = Nothing
Exit Function
ErrorHandler:
MsgBox "Error number: " & Err.Number - vbObjectError & vbNewLine & Err.Description & vbNewLine & vbNewLine & "Contate o suporte técnico de TI!", vbCritical, "Mensagem de erro"
adoConnection.RollbackTrans
Set rs = Nothing
End Function