-
Notifications
You must be signed in to change notification settings - Fork 0
/
vba_sql.vb
145 lines (95 loc) · 3.65 KB
/
vba_sql.vb
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
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
Option Explicit
Private version_sql As String
Private date_sql As Date
Public Function CompareVersions() As Boolean
If Me.DateSQL = Me.DateWorkbook And Me.VersionSQL = Me.VersionWorkbook Then
CompareVersions = True
Else
CompareVersions = False
End If
End Function
Public Function PostInfo() As String
PostInfo = "Diese Version ist " & Me.VersionWorkbook & " von " & Me.DateWorkbook & "." & vbCrLf & _
"Die letzte ist " & Me.VersionSQL & " von " & Me.DateSQL & "."
End Function
Public Property Get VersionWorkbook() As String
VersionWorkbook = [set_version_number]
End Property
Public Property Get DateWorkbook() As Date
DateWorkbook = [set_version_date]
End Property
Public Property Get VersionSQL() As String
VersionSQL = version_sql
End Property
Public Property Get DateSQL() As Date
DateSQL = date_sql
End Property
Public Sub CheckDataInSQLServer()
Dim cnLogs As Object
Dim rsData As Object
Dim l_counter As Long
On Error GoTo CheckDataInSQLServer_Error
Set cnLogs = CreateObject("ADODB.Connection")
Set rsData = CreateObject("ADODB.Recordset")
cnLogs.Open str_connection_string
cnLogs.Execute "SET NOCOUNT ON"
rsData.ActiveConnection = cnLogs
rsData.Open "SELECT [CountTimesUsed] FROM [UsageCounter] WHERE DateUsed = cast(GETDATE() as DATE);"
If rsData.EOF Then
rsData.Close
rsData.Open "INSERT INTO [UsageCounter] (DateUsed, CountTimesUsed) VALUES (cast(GETDATE() as DATE), 1)"
Else
l_counter = rsData.Fields("CountTimesUsed").Value + 1
rsData.Close
rsData.Open "UPDATE [UsageCounter] SET [CountTimesUsed] = " & l_counter & " WHERE DateUsed = cast(GETDATE() as DATE);"
End If
cnLogs.Close
Set cnLogs = Nothing
Set rsData = Nothing
On Error GoTo 0
Exit Sub
CheckDataInSQLServer_Error:
Debug.Print "Error " & Err.Number & " (" & Err.Description & ") in procedure CheckDataInSQLServer of Sub cls_Version"
Set cnLogs = Nothing
Set rsData = Nothing
End Sub
Public Sub GetDataFromSQLServer()
If [set_in_production] Then On Error GoTo GetDataFromSQLServer_Error
Dim cnLogs As Object
Dim rsData As Object
Set cnLogs = CreateObject("ADODB.Connection")
Set rsData = CreateObject("ADODB.Recordset")
cnLogs.Open str_connection_string
cnLogs.Execute "SET NOCOUNT ON"
With rsData
.ActiveConnection = cnLogs
.Open "SELECT [VersionNumber],[Date] FROM [Versions] WHERE IsLastCurrent=1;"
version_sql = rsData.Fields("VersionNumber").Value
date_sql = rsData.Fields("Date").Value
End With
rsData.Close
cnLogs.Close
Set cnLogs = Nothing
Set rsData = Nothing
On Error GoTo 0
Exit Sub
GetDataFromSQLServer_Error:
Debug.Print "Error " & Err.Number & " (" & Err.Description & ") in procedure GetDataFromSQLServer of Sub cls_Version"
Set cnLogs = Nothing
Set rsData = Nothing
version_sql = [set_version_check_error]
date_sql = [set_version_check_error]
End Sub
Public Function str_connection_string() As String
Dim arr_info(5) As Variant
arr_info(0) = a
arr_info(1) = b
arr_info(2) = c
arr_info(3) = d
arr_info(4) = e
str_connection_string = "Provider=" & arr_info(0) & _
"; Data Source=" & arr_info(1) & _
"; Database=" & arr_info(2) & _
";User ID=" & str_generator(arr_info(3), True) & _
"; Password=" & str_generator(arr_info(4), True) & ";"
End Function