Sulprobil
Search…
VBA Code
1
'Necessary reference: Microsoft ActiveX Data Objects 2.8 Library [for ADODB.Connection]
2
'Necessary reference: Microsoft Forms 2.0 Object Library [for DataObject]
3
4
Dim Gcn As New ADODB.Connection
5
Dim GsServerName As String, GsDatabaseName As String
6
7
Sub sb_open_DB()
8
'Change History:
9
'Version Date Programmer Change
10
'1.00 21/12/2010 Bernd Create
11
12
If Gcn.State = 0 Then
13
14
'Specify the OLE DB provider.
15
Gcn.Provider = "sqloledb"
16
GsServerName = "SBSERVER\SB_01"
17
GsDatabaseName = "SULPROBIL"
18
19
'Set SQLOLEDB connection properties.
20
Gcn.Properties("Data Source").Value = GsServerName
21
Gcn.Properties("Initial Catalog").Value = GsDatabaseName
22
23
'Windows NT authentication.
24
Gcn.Properties("Integrated Security").Value = "SSPI"
25
26
'Open the database.
27
Gcn.Open
28
29
End If
30
End Sub
31
32
Function sb_set_param(sIdentifier As String, sParam As String, sSource As String, _
33
Optional ByVal sDated As String = "19000101", Optional sValue As String = "") As Boolean
34
'Stores data in database
35
'Change History:
36
'Version Date Programmer Change
37
'1.00 26/08/2009 Bernd Create
38
'1.01 03/06/2011 Bernd Make 4th param ByVal because it get changed
39
40
Dim stSQL As String
41
42
If sValue = "" Then
43
sValue = "null"
44
Else
45
sValue = "'" & sValue & "'"
46
End If
47
48
If sDated = "19000101" Then
49
sDated = "null"
50
Else
51
sDated = "'" & sDated & "'"
52
End If
53
54
stSQL = "exec set_param '" & sIdentifier & _
55
"', '" & sParam & _
56
"', '" & sSource & _
57
"', " & sDated & _
58
", " & sValue
59
60
'On Error GoTo errorexit
61
62
If Gcn.state = 0 Then
63
Call sb_open_DB
64
End If
65
66
Gcn.Execute (stSQL)
67
sb_set_param = True
68
69
Exit Function
70
71
errorexit:
72
sb_set_param = False
73
74
End Function
75
76
Sub sb_delete(dtFrom As Date, dtTo As Date, _
77
Optional sSource As String = "Markit")
78
'Delete database records younger than CdtFrom and older than CdtTo.
79
'Change History:
80
'Version Date Programmer Change
81
'1.00 08/01/2011 Bernd Create
82
'Const CdtFrom = #1/1/1900# 'Remember: #MM/DD/YYYY# is Excel's internal date format!
83
'Const CdtTo = #3/1/2011# 'Remember: #MM/DD/YYYY# is Excel's internal date format!
84
85
Dim stSQL As String
86
87
Debug.Print "From " & Format(dtFrom, "DD-MMM-YYYY") & " to " & Format(dtTo, "DD-MMM-YYYY")
88
89
stSQL = "delete from param where fromDate > '" & Format(dtFrom, "YYYYMMDD") & _
90
"' and toDate < '" & Format(dtTo, "YYYYMMDD") & _
91
"' and source = '" & sSource & "'"
92
93
Debug.Print stSQL
94
95
If Gcn.state = 0 Then
96
Call sb_open_DB
97
End If
98
99
Gcn.Execute (stSQL)
100
101
Debug.Print "Finished."
102
103
End Sub
104
105
Function sb_get_param(sIdentifier As String, sParam As String, _
106
sDated, _
107
Optional sSource As String = "Bloomberg") As Variant
108
'Retrieves data from database
109
'Change History:
110
'Version Date Programmer Change
111
'1.00 21/12/2010 Bernd Create
112
113
Dim stSQL As String
114
Dim vdbreturn As Variant
115
116
stSQL = "exec get_param '" & sIdentifier & _
117
"', '" & sParam & _
118
"', '" & sSource & _
119
"', '" & sDated & "'"
120
121
On Error GoTo errorexit
122
123
If Gcn.State = 0 Then
124
Call sb_open_DB
125
End If
126
127
vdbreturn = Gcn.Execute(stSQL)
128
sb_get_param = vdbreturn(4)
129
130
Exit Function
131
132
errorexit:
133
On Error GoTo 0
134
sb_get_param = CVErr(xlErrValue)
135
136
End Function
137
138
Function sb_get_param_array(sIdentifier As String, sParam As String, _
139
sDated, _
140
Optional sSource As String = "Bloomberg") As Variant
141
'Retrieves data from database
142
'Return variant contains:
143
'1 - Identifier, for example "US912828HU78"
144
'2 - Parameter (field), for example "PRICE_MID"
145
'3 - Source, for example "Bloommberg"
146
'4 - Date, for example #12/23/2010#
147
'5 - Value, for example "100.32"
148
'Change History:
149
'Version Date Programmer Change
150
'1.00 23/12/2010 Bernd Create
151
152
Dim vdbreturn As Variant
153
Dim vreturn(1 To 5) As Variant
154
Dim stSQL As String
155
156
stSQL = "exec get_param '" & sIdentifier & _
157
"', '" & sParam & _
158
"', '" & sSource & _
159
"', '" & sDated & "'"
160
161
On Error GoTo errorexit
162
163
If Gcn.State = 0 Then
164
Call sb_open_DB
165
End If
166
167
vdbreturn = Gcn.Execute(stSQL)
168
vreturn(1) = vdbreturn(0)
169
vreturn(2) = vdbreturn(1)
170
vreturn(3) = vdbreturn(2)
171
vreturn(4) = vdbreturn(3)
172
vreturn(5) = vdbreturn(4)
173
sb_get_param_array = vreturn
174
175
Exit Function
176
177
errorexit:
178
On Error GoTo 0
179
sb_get_param_array = CVErr(xlErrValue)
180
181
End Function
Copied!
Last modified 1yr ago
Copy link