VBA Code

'Necessary reference: Microsoft ActiveX Data Objects 2.8 Library [for ADODB.Connection]
'Necessary reference: Microsoft Forms 2.0 Object Library [for DataObject]
Dim Gcn As New ADODB.Connection
Dim GsServerName As String, GsDatabaseName As String
Sub sb_open_DB()
'Change History:
'Version Date Programmer Change
'1.00 21/12/2010 Bernd Create
If Gcn.State = 0 Then
'Specify the OLE DB provider.
Gcn.Provider = "sqloledb"
GsServerName = "SBSERVER\SB_01"
GsDatabaseName = "SULPROBIL"
'Set SQLOLEDB connection properties.
Gcn.Properties("Data Source").Value = GsServerName
Gcn.Properties("Initial Catalog").Value = GsDatabaseName
'Windows NT authentication.
Gcn.Properties("Integrated Security").Value = "SSPI"
'Open the database.
Gcn.Open
End If
End Sub
Function sb_set_param(sIdentifier As String, sParam As String, sSource As String, _
Optional ByVal sDated As String = "19000101", Optional sValue As String = "") As Boolean
'Stores data in database
'Change History:
'Version Date Programmer Change
'1.00 26/08/2009 Bernd Create
'1.01 03/06/2011 Bernd Make 4th param ByVal because it get changed
Dim stSQL As String
If sValue = "" Then
sValue = "null"
Else
sValue = "'" & sValue & "'"
End If
If sDated = "19000101" Then
sDated = "null"
Else
sDated = "'" & sDated & "'"
End If
stSQL = "exec set_param '" & sIdentifier & _
"', '" & sParam & _
"', '" & sSource & _
"', " & sDated & _
", " & sValue
'On Error GoTo errorexit
If Gcn.state = 0 Then
Call sb_open_DB
End If
Gcn.Execute (stSQL)
sb_set_param = True
Exit Function
errorexit:
sb_set_param = False
End Function
Sub sb_delete(dtFrom As Date, dtTo As Date, _
Optional sSource As String = "Markit")
'Delete database records younger than CdtFrom and older than CdtTo.
'Change History:
'Version Date Programmer Change
'1.00 08/01/2011 Bernd Create
'Const CdtFrom = #1/1/1900# 'Remember: #MM/DD/YYYY# is Excel's internal date format!
'Const CdtTo = #3/1/2011# 'Remember: #MM/DD/YYYY# is Excel's internal date format!
Dim stSQL As String
Debug.Print "From " & Format(dtFrom, "DD-MMM-YYYY") & " to " & Format(dtTo, "DD-MMM-YYYY")
stSQL = "delete from param where fromDate > '" & Format(dtFrom, "YYYYMMDD") & _
"' and toDate < '" & Format(dtTo, "YYYYMMDD") & _
"' and source = '" & sSource & "'"
Debug.Print stSQL
If Gcn.state = 0 Then
Call sb_open_DB
End If
Gcn.Execute (stSQL)
Debug.Print "Finished."
End Sub
Function sb_get_param(sIdentifier As String, sParam As String, _
sDated, _
Optional sSource As String = "Bloomberg") As Variant
'Retrieves data from database
'Change History:
'Version Date Programmer Change
'1.00 21/12/2010 Bernd Create
Dim stSQL As String
Dim vdbreturn As Variant
stSQL = "exec get_param '" & sIdentifier & _
"', '" & sParam & _
"', '" & sSource & _
"', '" & sDated & "'"
On Error GoTo errorexit
If Gcn.State = 0 Then
Call sb_open_DB
End If
vdbreturn = Gcn.Execute(stSQL)
sb_get_param = vdbreturn(4)
Exit Function
errorexit:
On Error GoTo 0
sb_get_param = CVErr(xlErrValue)
End Function
Function sb_get_param_array(sIdentifier As String, sParam As String, _
sDated, _
Optional sSource As String = "Bloomberg") As Variant
'Retrieves data from database
'Return variant contains:
'1 - Identifier, for example "US912828HU78"
'2 - Parameter (field), for example "PRICE_MID"
'3 - Source, for example "Bloommberg"
'4 - Date, for example #12/23/2010#
'5 - Value, for example "100.32"
'Change History:
'Version Date Programmer Change
'1.00 23/12/2010 Bernd Create
Dim vdbreturn As Variant
Dim vreturn(1 To 5) As Variant
Dim stSQL As String
stSQL = "exec get_param '" & sIdentifier & _
"', '" & sParam & _
"', '" & sSource & _
"', '" & sDated & "'"
On Error GoTo errorexit
If Gcn.State = 0 Then
Call sb_open_DB
End If
vdbreturn = Gcn.Execute(stSQL)
vreturn(1) = vdbreturn(0)
vreturn(2) = vdbreturn(1)
vreturn(3) = vdbreturn(2)
vreturn(4) = vdbreturn(3)
vreturn(5) = vdbreturn(4)
sb_get_param_array = vreturn
Exit Function
errorexit:
On Error GoTo 0
sb_get_param_array = CVErr(xlErrValue)
End Function