Component File /DataExtractClass.vb (VB.NET)
1: Option Strict Off
2: Option Explicit On
3: Friend Class DataExtractClass
4: Public DatabaseStoreConnectionString As String
5:
6: Public Sub SetDataStoreConnectionString(ByRef ConnectionString As String)
7:
8: DatabaseStoreConnectionString = ConnectionString
9:
10: End Sub
11: 'Extract database specific content (e.g. DTS Packages and Jobs)
12: Public Function ExtractDatabaseSpecificContent(ByRef ProjectID As Integer, ByRef ParseID As Integer, ByRef CurrentConnectionID As Integer, ByRef ConnectionDatabaseServer As String, ByRef ConnectionDatabaseUserName As String, ByRef ConnectionDatabasePassword As String, ByRef UseTrustedConnection As Boolean) As Boolean
13: Dim CurrentName As Object
14: Dim HasDatabaseSQLError As Object
15: Dim HasDatabaseConnectionError As Object
16: Dim DataError As Object
17: Dim DatabaseConnectionString As Object
18: Dim ConnectionDatabaseName As Object
19:
20:
21: Dim SQLServerConnectionString As String
22:
23: If UseTrustedConnection Then
24:
25: SQLServerConnectionString = "Driver={SQL Server};Trusted_Connection=yes;"
26: SQLServerConnectionString = SQLServerConnectionString & "Server=" & ConnectionDatabaseServer & ";"
27: 'UPGRADE_WARNING: Couldn't resolve default property of object ConnectionDatabaseName. Click for more: 'ms-help://MS.VSCC.2003/commoner/redir/redirect.htm?keyword="vbup1037"'
28: SQLServerConnectionString = SQLServerConnectionString & "Initial Catalog=" & ConnectionDatabaseName & ";"
29: SQLServerConnectionString = SQLServerConnectionString & "Use Procedure for Prepare=1;Auto Translate=True;Packet Size=4096;"
30: SQLServerConnectionString = SQLServerConnectionString & ""
31:
32: 'UPGRADE_WARNING: Couldn't resolve default property of object ConnectionDatabaseName. Click for more: 'ms-help://MS.VSCC.2003/commoner/redir/redirect.htm?keyword="vbup1037"'
33: FormMain.DefInstance.UpdateStatus(("Using trusted database connection to connect to " & ConnectionDatabaseName))
34: 'UPGRADE_WARNING: Couldn't resolve default property of object ConnectionDatabaseName. Click for more: 'ms-help://MS.VSCC.2003/commoner/redir/redirect.htm?keyword="vbup1037"'
35: Call AppendToLogFile(CurrentLogFileName, vbTab & "Using trusted database connection to connect to database '" & ConnectionDatabaseName & "'" & vbCrLf)
36:
37: Else
38:
39: SQLServerConnectionString = "Provider=SQLOLEDB.1;Persist Security Info=True;"
40: 'UPGRADE_WARNING: Couldn't resolve default property of object ConnectionDatabaseName. Click for more: 'ms-help://MS.VSCC.2003/commoner/redir/redirect.htm?keyword="vbup1037"'
41: SQLServerConnectionString = SQLServerConnectionString & "Initial Catalog=" & ConnectionDatabaseName & ";"
42: SQLServerConnectionString = SQLServerConnectionString & "Data Source=" & ConnectionDatabaseServer & ";"
43: SQLServerConnectionString = SQLServerConnectionString & "Use Procedure for Prepare=1;Auto Translate=True;Packet Size=4096;"
44: SQLServerConnectionString = SQLServerConnectionString & "User Id=" & ConnectionDatabaseUserName & ";"
45: SQLServerConnectionString = SQLServerConnectionString & "PASSWORD=" & ConnectionDatabasePassword & ";"
46: SQLServerConnectionString = SQLServerConnectionString & ""
47:
48: 'UPGRADE_WARNING: Couldn't resolve default property of object ConnectionDatabaseName. Click for more: 'ms-help://MS.VSCC.2003/commoner/redir/redirect.htm?keyword="vbup1037"'
49: FormMain.DefInstance.UpdateStatus(("Using trusted database connection to connect to " & ConnectionDatabaseName))
50: 'UPGRADE_WARNING: Couldn't resolve default property of object ConnectionDatabaseName. Click for more: 'ms-help://MS.VSCC.2003/commoner/redir/redirect.htm?keyword="vbup1037"'
51: Call AppendToLogFile(CurrentLogFileName, vbTab & "Using SQL login '" & ConnectionDatabaseUserName & "' to connect to database '" & ConnectionDatabaseName & "'" & vbCrLf)
52:
53: End If
54:
55: 'Debug.Print SQLServerConnectionString
56: Call FormMain.DefInstance.UpdateCurrentItem("")
57:
58: Dim DataStore As New DataStoreClass
59: DataStore.SetConnectionString((DatabaseStoreConnectionString))
60:
61: Dim RS As New ADODB.Recordset
62: Dim RS2 As New ADODB.Recordset
63: Dim RS3 As New ADODB.Recordset
64: Dim RSJobStep As New ADODB.Recordset
65: Dim RSJobSchedule As New ADODB.Recordset
66: Dim DataConnection As New ADODB.Connection
67: Dim SQL As String
68: Dim CurrentPackageName As String
69: Dim CurrentPackageDescription As String
70: Dim CurrentPackageOwner As String
71: Dim CurrentPackageID As Integer
72: Dim CurrentPackageCreateDate As String
73: Dim CurrentPackageSize As Integer
74: Dim CurrentJobID As Integer
75: Dim CurrentJobName As String
76: Dim CurrentJobDescription As String
77: Dim CurrentJobGUID As String
78: Dim CurrentJobIsEnabled As Boolean
79: Dim CurrentJobStartStepID As Integer
80: Dim CurrentJobCategory As String
81: Dim CurrentJobOwner As String
82: Dim CurrentJobCreateDate As String
83: Dim CurrentJobModifiedDate As String
84: Dim CurrentJobStepID As Short
85: Dim CurrentJobStepSQLID As Short
86: Dim CurrentJobStepName As String
87: Dim CurrentJobStepSubsystem As String
88: Dim CurrentJobStepCommand As String
89: Dim CurrentJobOnSuccessStepSQLID As Short
90: Dim CurrentJobOnFailStepSQLID As Short
91: Dim CurrentJobStepRetryAttempts As Short
92: Dim CurrentJobStepRetryInterval As Short
93: Dim CurrentJobStepOnSuccessActionID As Short
94: Dim CurrentJobStepOnFailActionID As Short
95: Dim CurrentJobStepOnSuccessAction As String
96: Dim CurrentJobStepOnFailAction As String
97: Dim CurrentJobScheduleID As Integer
98: Dim CurrentJobScheduleName As String
99: Dim CurrentJobScheduleFrequencyTypeID As Short
100: Dim CurrentJobScheduleFrequencyTypeName As String
101: Dim CurrentJobScheduleCreateDate As String
102: Dim CurrentJobScheduleDescription As String
103: Dim CurrentJobScheduleIsEnabled As Boolean
104: Dim CurrentJobScheduleFrequencyIntervalID As Short
105: Dim CurrentJobScheduleFrequencyInterval As String
106: Dim CurrentJobScheduleFrequencyRelativeIntervalID As Short
107: Dim CurrentJobScheduleFrequencyRelativeName As String
108: Dim CurrentJobScheduleStartDate As String
109: Dim CurrentJobScheduleEndDate As String
110: Dim CurrentJobScheduleStartTime As String
111: Dim CurrentJobScheduleEndTime As String
112: Dim CurrentJobScheduleStartTimeString As String
113: Dim CurrentJobScheduleEndTimeString As String
114: Dim CurrentJobScheduleStartDateString As String
115: Dim CurrentJobScheduleEndDateString As String
116: Dim CurrentJobScheduleFrequencySubDayType As Short
117: Dim CurrentJobScheduleFrequencySubDayInterval As Short
118:
119: Dim InsertSQL As String
120:
121: On Error Resume Next
122: 'UPGRADE_WARNING: Couldn't resolve default property of object DatabaseConnectionString. Click for more: 'ms-help://MS.VSCC.2003/commoner/redir/redirect.htm?keyword="vbup1037"'
123: DataConnection.ConnectionString = DatabaseConnectionString
124: DataConnection.Open(SQLServerConnectionString)
125:
126: If CurrentProjectDocumentDTSPackages Then
127:
128: FormMain.DefInstance.UpdateStatus(("Extracting DTS packages from server " & ConnectionDatabaseServer))
129: Call AppendToLogFile(CurrentLogFileName, vbTab & "Extracting DTS packages from server '" & ConnectionDatabaseServer & "'" & vbCrLf)
130: ', adOpenForwardOnly, adLockReadOnly
131:
132: 'Ensure database can be opened
133: If DataConnection.State = 0 Then
134: 'UPGRADE_WARNING: Couldn't resolve default property of object ConnectionDatabaseName. Click for more: 'ms-help://MS.VSCC.2003/commoner/redir/redirect.htm?keyword="vbup1037"'
135: FormMain.DefInstance.UpdateStatus(("Cannot open the SQL Server database " & ConnectionDatabaseName))
136: 'UPGRADE_WARNING: Couldn't resolve default property of object ConnectionDatabaseName. Click for more: 'ms-help://MS.VSCC.2003/commoner/redir/redirect.htm?keyword="vbup1037"'
137: Call AppendToLogFile(CurrentLogFileName, "ERROR: Cannot open the SQL Server database " & ConnectionDatabaseName & " on server " & ConnectionDatabaseServer & vbCrLf)
138:
139: If DataConnection.Errors.Count > 0 Then
140: For Each DataError In DataConnection.Errors
141:
142: 'UPGRADE_WARNING: Couldn't resolve default property of object DataError. Click for more: 'ms-help://MS.VSCC.2003/commoner/redir/redirect.htm?keyword="vbup1037"'
143: Call AppendToLogFile(CurrentLogFileName, vbTab & "ERROR: SQL Server error: " & DataError & vbCrLf)
144:
145: Next DataError
146: End If
147:
148: 'UPGRADE_WARNING: Couldn't resolve default property of object HasDatabaseConnectionError. Click for more: 'ms-help://MS.VSCC.2003/commoner/redir/redirect.htm?keyword="vbup1037"'
149: HasDatabaseConnectionError = True
150: Else
151: 'UPGRADE_WARNING: Couldn't resolve default property of object HasDatabaseConnectionError. Click for more: 'ms-help://MS.VSCC.2003/commoner/redir/redirect.htm?keyword="vbup1037"'
152: HasDatabaseConnectionError = False
153: End If
154:
155: 'Extract DTS Packages
156: 'UPGRADE_WARNING: Couldn't resolve default property of object HasDatabaseConnectionError. Click for more: 'ms-help://MS.VSCC.2003/commoner/redir/redirect.htm?keyword="vbup1037"'
157: If HasDatabaseConnectionError = False Then
158: SQL = "EXEC msdb..sp_enum_dtspackages"
159: Call AppendToLogFile(CurrentLogFileName, vbTab & "Executing SQL statement: " & SQL & vbCrLf)
160: RS = DataConnection.Execute(SQL)
161:
162: If DataConnection.Errors.Count > 0 Then
163: 'UPGRADE_WARNING: Couldn't resolve default property of object ConnectionDatabaseName. Click for more: 'ms-help://MS.VSCC.2003/commoner/redir/redirect.htm?keyword="vbup1037"'
164: FormMain.DefInstance.UpdateStatus(("Problem with SQL statement (see log) " & ConnectionDatabaseName))
165: Call AppendToLogFile(CurrentLogFileName, vbTab & "ERROR: Problem executing the SQL statement: " & SQL & vbCrLf)
166:
167: If DataConnection.Errors.Count > 0 Then
168: For Each DataError In DataConnection.Errors
169:
170: 'UPGRADE_WARNING: Couldn't resolve default property of object DataError. Click for more: 'ms-help://MS.VSCC.2003/commoner/redir/redirect.htm?keyword="vbup1037"'
171: Call AppendToLogFile(CurrentLogFileName, vbTab & "ERROR: SQL Server error: " & DataError & vbCrLf)
172:
173: Next DataError
174: End If
175:
176: 'UPGRADE_WARNING: Couldn't resolve default property of object HasDatabaseSQLError. Click for more: 'ms-help://MS.VSCC.2003/commoner/redir/redirect.htm?keyword="vbup1037"'
177: HasDatabaseSQLError = True
178: Else
179: 'UPGRADE_WARNING: Couldn't resolve default property of object HasDatabaseSQLError. Click for more: 'ms-help://MS.VSCC.2003/commoner/redir/redirect.htm?keyword="vbup1037"'
180: HasDatabaseSQLError = False
181: End If
182:
183: 'UPGRADE_WARNING: Couldn't resolve default property of object HasDatabaseSQLError. Click for more: 'ms-help://MS.VSCC.2003/commoner/redir/redirect.htm?keyword="vbup1037"'
184: If HasDatabaseSQLError = False Then
185: Do While Not RS.EOF
186:
187: CurrentPackageName = RS.Fields("name").Value
188: CurrentPackageDescription = RS.Fields("description").Value
189: CurrentPackageOwner = RS.Fields("owner").Value
190: CurrentPackageCreateDate = RS.Fields("createdate").Value
191: CurrentPackageSize = RS.Fields("size").Value
192:
193: CurrentPackageName = Replace(CurrentPackageName, "'", "''")
194: CurrentPackageDescription = Replace(CurrentPackageDescription, "'", "''")
195: CurrentPackageOwner = Replace(CurrentPackageOwner, "'", "''")
196:
197: Call AppendToLogFile(CurrentLogFileName, vbTab & vbTab & "Found DTS Package '" & CurrentPackageName & "' in server '" & ConnectionDatabaseServer & "'" & vbCrLf)
198: Call FormMain.DefInstance.UpdateCurrentItem(ConnectionDatabaseServer & ".." & CurrentPackageName)
199:
200: 'Store this DTS Package
201: InsertSQL = "INSERT INTO "
202: InsertSQL = InsertSQL & "t_Packages "
203: InsertSQL = InsertSQL & "( "
204: InsertSQL = InsertSQL & "fk_ParseID, "
205: InsertSQL = InsertSQL & "fk_ConnectionID, "
206: InsertSQL = InsertSQL & "PackageName, "
207: InsertSQL = InsertSQL & "PackageDescription, "
208: InsertSQL = InsertSQL & "PackageOwner, "
209: InsertSQL = InsertSQL & "PackageCreateDate, "
210: InsertSQL = InsertSQL & "PackageSize "
211: InsertSQL = InsertSQL & ") values ("
212: InsertSQL = InsertSQL & ParseID & ", "
213: InsertSQL = InsertSQL & CurrentConnectionID & ", "
214: InsertSQL = InsertSQL & "'" & CurrentPackageName & "', "
215: InsertSQL = InsertSQL & "'" & CurrentPackageDescription & "', "
216: InsertSQL = InsertSQL & "'" & CurrentPackageOwner & "', "
217: InsertSQL = InsertSQL & "'" & CurrentPackageCreateDate & "', "
218: InsertSQL = InsertSQL & CurrentPackageSize
219: InsertSQL = InsertSQL & ")"
220:
221: 'InsertSQLResult = DataStore.ExecuteSQL(InsertSQL)
222: CurrentPackageID = DataStore.ExecuteSQLReturnIdentity(InsertSQL)
223:
224: RS.MoveNext()
225: Loop
226: End If
227:
228: End If 'End of DTS Packages
229:
230: End If 'End of ensuring that CurrentProjectDocumentDTSPackages is true
231:
232: Dim Result As Short
233: If CurrentProjectDocumentJobs Then
234:
235: 'Extract Jobs
236: FormMain.DefInstance.UpdateStatus(("Extracting Jobs from server " & ConnectionDatabaseServer))
237: Call AppendToLogFile(CurrentLogFileName, vbTab & "Extracting Jobs from server '" & ConnectionDatabaseServer & "'" & vbCrLf)
238: ' DataConnection.ConnectionString = DatabaseConnectionString
239: ' DataConnection.Open SQLServerConnectionString ', adOpenForwardOnly, adLockReadOnly
240:
241: 'UPGRADE_WARNING: Couldn't resolve default property of object HasDatabaseConnectionError. Click for more: 'ms-help://MS.VSCC.2003/commoner/redir/redirect.htm?keyword="vbup1037"'
242: If HasDatabaseConnectionError = False Then
243: SQL = "EXEC msdb..sp_help_job"
244: Call AppendToLogFile(CurrentLogFileName, vbTab & "Executing SQL statement: " & SQL & vbCrLf)
245: RS = DataConnection.Execute(SQL)
246:
247: If DataConnection.Errors.Count > 0 Then
248: 'UPGRADE_WARNING: Couldn't resolve default property of object ConnectionDatabaseName. Click for more: 'ms-help://MS.VSCC.2003/commoner/redir/redirect.htm?keyword="vbup1037"'
249: FormMain.DefInstance.UpdateStatus(("Problem with SQL statement (see log) " & ConnectionDatabaseName))
250: Call AppendToLogFile(CurrentLogFileName, vbTab & "ERROR: Problem executing the SQL statement: " & SQL & vbCrLf)
251:
252: If DataConnection.Errors.Count > 0 Then
253: For Each DataError In DataConnection.Errors
254:
255: 'UPGRADE_WARNING: Couldn't resolve default property of object DataError. Click for more: 'ms-help://MS.VSCC.2003/commoner/redir/redirect.htm?keyword="vbup1037"'
256: Call AppendToLogFile(CurrentLogFileName, vbTab & "ERROR: SQL Server error: " & DataError & vbCrLf)
257:
258: Next DataError
259: End If
260:
261: 'UPGRADE_WARNING: Couldn't resolve default property of object HasDatabaseSQLError. Click for more: 'ms-help://MS.VSCC.2003/commoner/redir/redirect.htm?keyword="vbup1037"'
262: HasDatabaseSQLError = True
263: Else
264: 'UPGRADE_WARNING: Couldn't resolve default property of object HasDatabaseSQLError. Click for more: 'ms-help://MS.VSCC.2003/commoner/redir/redirect.htm?keyword="vbup1037"'
265: HasDatabaseSQLError = False
266: End If
267:
268: 'UPGRADE_WARNING: Couldn't resolve default property of object HasDatabaseSQLError. Click for more: 'ms-help://MS.VSCC.2003/commoner/redir/redirect.htm?keyword="vbup1037"'
269: If HasDatabaseSQLError = False Then
270: Do While Not RS.EOF
271:
272: CurrentJobName = RS.Fields("name").Value
273: CurrentJobDescription = RS.Fields("description").Value
274: CurrentJobIsEnabled = RS.Fields("enabled").Value
275: CurrentJobStartStepID = RS.Fields("start_step_id").Value
276: CurrentJobCategory = RS.Fields("category").Value
277: CurrentJobOwner = RS.Fields("owner").Value
278: CurrentJobCreateDate = RS.Fields("date_created").Value
279: CurrentJobModifiedDate = RS.Fields("date_modified").Value
280: CurrentJobGUID = RS.Fields("job_id").Value
281:
282: CurrentJobName = Replace(CurrentJobName, "'", "''")
283: CurrentJobDescription = Replace(CurrentJobDescription, "'", "''")
284: CurrentJobCategory = Replace(CurrentJobCategory, "'", "''")
285: CurrentJobOwner = Replace(CurrentJobOwner, "'", "''")
286:
287: 'UPGRADE_WARNING: Couldn't resolve default property of object CurrentName. Click for more: 'ms-help://MS.VSCC.2003/commoner/redir/redirect.htm?keyword="vbup1037"'
288: Call AppendToLogFile(CurrentLogFileName, vbTab & vbTab & "Found Job '" & CurrentName & "' in server '" & ConnectionDatabaseServer & "'" & vbCrLf)
289: Call FormMain.DefInstance.UpdateCurrentItem(ConnectionDatabaseServer & ".." & CurrentJobName)
290:
291: 'Store this Job
292: InsertSQL = "INSERT INTO "
293: InsertSQL = InsertSQL & "t_Jobs "
294: InsertSQL = InsertSQL & "( "
295: InsertSQL = InsertSQL & "fk_ParseID, "
296: InsertSQL = InsertSQL & "fk_ConnectionID, "
297: InsertSQL = InsertSQL & "JobName, "
298: InsertSQL = InsertSQL & "JobDescription, "
299: InsertSQL = InsertSQL & "JobIsEnabled, "
300: InsertSQL = InsertSQL & "JobStartStepID, "
301: InsertSQL = InsertSQL & "JobCategory, "
302: InsertSQL = InsertSQL & "JobOwner, "
303: InsertSQL = InsertSQL & "JobCreateDate, "
304: InsertSQL = InsertSQL & "JobModifiedDate "
305: InsertSQL = InsertSQL & ") values ("
306: InsertSQL = InsertSQL & ParseID & ", "
307: InsertSQL = InsertSQL & CurrentConnectionID & ", "
308: InsertSQL = InsertSQL & "'" & CurrentJobName & "', "
309: InsertSQL = InsertSQL & "'" & CurrentJobDescription & "', "
310: InsertSQL = InsertSQL & CurrentJobIsEnabled & ", "
311: InsertSQL = InsertSQL & CurrentJobStartStepID & ", "
312: InsertSQL = InsertSQL & "'" & CurrentJobCategory & "', "
313: InsertSQL = InsertSQL & "'" & CurrentJobOwner & "', "
314: InsertSQL = InsertSQL & "'" & CurrentJobCreateDate & "', "
315: InsertSQL = InsertSQL & "'" & CurrentJobModifiedDate & "' "
316: InsertSQL = InsertSQL & ")"
317:
318: 'InsertSQLResult = DataStore.ExecuteSQL(InsertSQL)
319: CurrentJobID = DataStore.ExecuteSQLReturnIdentity(InsertSQL)
320:
321: 'Get the Jobs Steps for this Job
322: Call AppendToLogFile(CurrentLogFileName, vbTab & "Extracting Jobs Steps from server '" & ConnectionDatabaseServer & "' for Job '" & CurrentJobName & "'" & vbCrLf)
323:
324: 'UPGRADE_WARNING: Couldn't resolve default property of object HasDatabaseConnectionError. Click for more: 'ms-help://MS.VSCC.2003/commoner/redir/redirect.htm?keyword="vbup1037"'
325: If HasDatabaseConnectionError = False Then
326: SQL = "EXEC msdb..sp_help_jobstep '" & CurrentJobGUID & "'"
327: Call AppendToLogFile(CurrentLogFileName, vbTab & "Executing SQL statement: " & SQL & vbCrLf)
328: RSJobStep = DataConnection.Execute(SQL)
329:
330: If DataConnection.Errors.Count > 0 Then
331: 'UPGRADE_WARNING: Couldn't resolve default property of object ConnectionDatabaseName. Click for more: 'ms-help://MS.VSCC.2003/commoner/redir/redirect.htm?keyword="vbup1037"'
332: FormMain.DefInstance.UpdateStatus(("Problem with SQL statement (see log) " & ConnectionDatabaseName))
333: Call AppendToLogFile(CurrentLogFileName, vbTab & "ERROR: Problem executing the SQL statement: " & SQL & vbCrLf)
334:
335: If DataConnection.Errors.Count > 0 Then
336: For Each DataError In DataConnection.Errors
337:
338: 'UPGRADE_WARNING: Couldn't resolve default property of object DataError. Click for more: 'ms-help://MS.VSCC.2003/commoner/redir/redirect.htm?keyword="vbup1037"'
339: Call AppendToLogFile(CurrentLogFileName, vbTab & "ERROR: SQL Server error: " & DataError & vbCrLf)
340:
341: Next DataError
342: End If
343:
344: 'UPGRADE_WARNING: Couldn't resolve default property of object HasDatabaseSQLError. Click for more: 'ms-help://MS.VSCC.2003/commoner/redir/redirect.htm?keyword="vbup1037"'
345: HasDatabaseSQLError = True
346: Else
347: 'UPGRADE_WARNING: Couldn't resolve default property of object HasDatabaseSQLError. Click for more: 'ms-help://MS.VSCC.2003/commoner/redir/redirect.htm?keyword="vbup1037"'
348: HasDatabaseSQLError = False
349: End If
350:
351: 'UPGRADE_WARNING: Couldn't resolve default property of object HasDatabaseSQLError. Click for more: 'ms-help://MS.VSCC.2003/commoner/redir/redirect.htm?keyword="vbup1037"'
352: If HasDatabaseSQLError = False Then
353:
354: Do While Not RSJobStep.EOF
355:
356: CurrentJobStepSQLID = RSJobStep.Fields("step_id").Value
357: CurrentJobStepName = RSJobStep.Fields("step_name").Value
358: CurrentJobStepSubsystem = RSJobStep.Fields("subsystem").Value
359: CurrentJobStepCommand = RSJobStep.Fields("command").Value
360: CurrentJobOnSuccessStepSQLID = RSJobStep.Fields("on_success_step_id").Value
361: CurrentJobOnFailStepSQLID = RSJobStep.Fields("on_fail_step_id").Value
362: CurrentJobStepRetryAttempts = RSJobStep.Fields("retry_attempts").Value
363: CurrentJobStepRetryInterval = RSJobStep.Fields("retry_interval").Value
364: CurrentJobStepOnSuccessActionID = RSJobStep.Fields("on_success_action").Value
365: CurrentJobStepOnFailActionID = RSJobStep.Fields("on_fail_action").Value
366:
367: Select Case CurrentJobStepOnSuccessActionID
368: Case 1
369: CurrentJobStepOnSuccessAction = "Quit the job reporting success."
370: Case 2
371: CurrentJobStepOnSuccessAction = "Quit the job reporting failure."
372: Case 3
373: CurrentJobStepOnSuccessAction = "Go to the next step."
374: Case 4
375: CurrentJobStepOnSuccessAction = "Go to step."
376: Case Else
377: End Select
378:
379: Select Case CurrentJobStepOnFailActionID
380: Case 1
381: CurrentJobStepOnFailAction = "Quit the job reporting success."
382: Case 2
383: CurrentJobStepOnFailAction = "Quit the job reporting failure."
384: Case 3
385: CurrentJobStepOnFailAction = "Go to the next step."
386: Case 4
387: CurrentJobStepOnFailAction = "Go to step."
388: Case Else
389: End Select
390:
391: CurrentJobStepName = Replace(CurrentJobStepName, "'", "''")
392: CurrentJobStepSubsystem = Replace(CurrentJobStepSubsystem, "'", "''")
393: CurrentJobStepCommand = Replace(CurrentJobStepCommand, "'", "''")
394:
395: 'Store this Job Step
396: InsertSQL = "INSERT INTO "
397: InsertSQL = InsertSQL & "t_JobSteps "
398: InsertSQL = InsertSQL & "( "
399: InsertSQL = InsertSQL & "fk_JobID, "
400: InsertSQL = InsertSQL & "JobStepSQLID, "
401: InsertSQL = InsertSQL & "JobStepName, "
402: InsertSQL = InsertSQL & "JobStepSubsystem, "
403: InsertSQL = InsertSQL & "JobStepCommand, "
404: InsertSQL = InsertSQL & "JobStepOnSuccessSQLID, "
405: InsertSQL = InsertSQL & "JobStepOnFailSQLID, "
406: InsertSQL = InsertSQL & "JobStepRetryAttempts, "
407: InsertSQL = InsertSQL & "JobStepRetryInterval, "
408: InsertSQL = InsertSQL & "JobStepOnSuccessActionID, "
409: InsertSQL = InsertSQL & "JobStepOnSuccessAction, "
410: InsertSQL = InsertSQL & "JobStepOnFailActionID, "
411: InsertSQL = InsertSQL & "JobStepOnFailAction "
412: InsertSQL = InsertSQL & ") values ("
413: InsertSQL = InsertSQL & CurrentJobID & ", "
414: InsertSQL = InsertSQL & CurrentJobStepSQLID & ", "
415: InsertSQL = InsertSQL & "'" & CurrentJobStepName & "', "
416: InsertSQL = InsertSQL & "'" & CurrentJobStepSubsystem & "', "
417: InsertSQL = InsertSQL & "'" & CurrentJobStepCommand & "', "
418: InsertSQL = InsertSQL & CurrentJobOnSuccessStepSQLID & ", "
419: InsertSQL = InsertSQL & CurrentJobOnFailStepSQLID & ", "
420: InsertSQL = InsertSQL & CurrentJobStepRetryAttempts & ", "
421: InsertSQL = InsertSQL & CurrentJobStepRetryInterval & ", "
422: InsertSQL = InsertSQL & CurrentJobStepOnSuccessActionID & ", "
423: InsertSQL = InsertSQL & "'" & CurrentJobStepOnSuccessAction & "', "
424: InsertSQL = InsertSQL & CurrentJobStepOnFailActionID & ", "
425: InsertSQL = InsertSQL & "'" & CurrentJobStepOnFailAction & "'"
426: InsertSQL = InsertSQL & ")"
427:
428: 'InsertSQLResult = DataStore.ExecuteSQL(InsertSQL)
429: CurrentJobStepID = DataStore.ExecuteSQLReturnIdentity(InsertSQL)
430:
431: RSJobStep.MoveNext()
432: Loop
433:
434: End If
435:
436:
437: End If
438:
439: 'Get the Jobs Steps for this Job
440: Call AppendToLogFile(CurrentLogFileName, vbTab & "Extracting Jobs Schedules from server '" & ConnectionDatabaseServer & "' for Job '" & CurrentJobName & "'" & vbCrLf)
441:
442: 'UPGRADE_WARNING: Couldn't resolve default property of object HasDatabaseConnectionError. Click for more: 'ms-help://MS.VSCC.2003/commoner/redir/redirect.htm?keyword="vbup1037"'
443: If HasDatabaseConnectionError = False Then
444: SQL = "EXEC msdb..sp_help_jobschedule '" & CurrentJobGUID & "'"
445: Call AppendToLogFile(CurrentLogFileName, vbTab & "Executing SQL statement: " & SQL & vbCrLf)
446: RSJobSchedule = DataConnection.Execute(SQL)
447:
448: If DataConnection.Errors.Count > 0 Then
449: 'UPGRADE_WARNING: Couldn't resolve default property of object ConnectionDatabaseName. Click for more: 'ms-help://MS.VSCC.2003/commoner/redir/redirect.htm?keyword="vbup1037"'
450: FormMain.DefInstance.UpdateStatus(("Problem with SQL statement (see log) " & ConnectionDatabaseName))
451: Call AppendToLogFile(CurrentLogFileName, vbTab & "ERROR: Problem executing the SQL statement: " & SQL & vbCrLf)
452:
453: If DataConnection.Errors.Count > 0 Then
454: For Each DataError In DataConnection.Errors
455:
456: 'UPGRADE_WARNING: Couldn't resolve default property of object DataError. Click for more: 'ms-help://MS.VSCC.2003/commoner/redir/redirect.htm?keyword="vbup1037"'
457: Call AppendToLogFile(CurrentLogFileName, vbTab & "ERROR: SQL Server error: " & DataError & vbCrLf)
458:
459: Next DataError
460: End If
461:
462: 'UPGRADE_WARNING: Couldn't resolve default property of object HasDatabaseSQLError. Click for more: 'ms-help://MS.VSCC.2003/commoner/redir/redirect.htm?keyword="vbup1037"'
463: HasDatabaseSQLError = True
464: Else
465: 'UPGRADE_WARNING: Couldn't resolve default property of object HasDatabaseSQLError. Click for more: 'ms-help://MS.VSCC.2003/commoner/redir/redirect.htm?keyword="vbup1037"'
466: HasDatabaseSQLError = False
467: End If
468:
469: 'UPGRADE_WARNING: Couldn't resolve default property of object HasDatabaseSQLError. Click for more: 'ms-help://MS.VSCC.2003/commoner/redir/redirect.htm?keyword="vbup1037"'
470: If HasDatabaseSQLError = False Then
471:
472: Do While Not RSJobSchedule.EOF
473:
474: CurrentJobScheduleName = RSJobSchedule.Fields("schedule_name").Value
475: CurrentJobScheduleDescription = RSJobSchedule.Fields("schedule_description").Value
476: CurrentJobScheduleFrequencyTypeID = RSJobSchedule.Fields("freq_type").Value
477: CurrentJobScheduleCreateDate = RSJobSchedule.Fields("date_created").Value
478: CurrentJobScheduleStartDate = RSJobSchedule.Fields("active_start_date").Value
479: CurrentJobScheduleEndDate = RSJobSchedule.Fields("active_end_date").Value
480: CurrentJobScheduleStartTime = RSJobSchedule.Fields("active_start_time").Value
481: CurrentJobScheduleEndTime = RSJobSchedule.Fields("active_end_time").Value
482: CurrentJobScheduleIsEnabled = RSJobSchedule.Fields("enabled").Value
483: CurrentJobScheduleFrequencyIntervalID = RSJobSchedule.Fields("freq_interval").Value
484: CurrentJobScheduleFrequencyRelativeIntervalID = RSJobSchedule.Fields("freq_relative_interval").Value
485: CurrentJobScheduleFrequencySubDayType = RSJobSchedule.Fields("freq_subday_type").Value
486: CurrentJobScheduleFrequencySubDayInterval = RSJobSchedule.Fields("freq_subday_interval").Value
487:
488: CurrentJobScheduleStartDateString = Left(CurrentJobScheduleStartDate, 4) & "-" & Mid(CurrentJobScheduleStartDate, 5, 2) & "-" & Mid(CurrentJobScheduleStartDate, 7, 2)
489: CurrentJobScheduleEndDateString = Left(CurrentJobScheduleEndDate, 4) & "-" & Mid(CurrentJobScheduleEndDate, 5, 2) & "-" & Mid(CurrentJobScheduleEndDate, 7, 2)
490:
491:
492:
493: 'Check if there is no end date
494: If CurrentJobScheduleEndDate = "99991231" Then
495: CurrentJobScheduleEndDate = ""
496: CurrentJobScheduleEndDateString = ""
497: End If
498:
499: 'Modify start time of 0
500: If CDbl(CurrentJobScheduleStartTime) = 0 Then
501: CurrentJobScheduleStartTime = "000000"
502: End If
503:
504: 'Put the leading zero on the time
505: If Len(CurrentJobScheduleStartTime) = 5 Then
506: CurrentJobScheduleStartTime = "0" & CurrentJobScheduleStartTime
507: End If
508:
509: If Len(CurrentJobScheduleEndTime) = 5 Then
510: CurrentJobScheduleEndTime = "0" & CurrentJobScheduleEndTime
511: End If
512:
513: 'Ensure time is actually required for this job schedule
514: If Len(CurrentJobScheduleStartTime) = 6 Then
515:
516: 'Make nicer looking start time
517: CurrentJobScheduleStartTimeString = Left(CurrentJobScheduleStartTime, 2)
518: CurrentJobScheduleStartTimeString = CurrentJobScheduleStartTimeString & ":"
519: CurrentJobScheduleStartTimeString = CurrentJobScheduleStartTimeString & Mid(CurrentJobScheduleStartTime, 3, 2)
520: CurrentJobScheduleStartTimeString = CurrentJobScheduleStartTimeString & ":"
521: CurrentJobScheduleStartTimeString = CurrentJobScheduleStartTimeString & Mid(CurrentJobScheduleStartTime, 5, 2)
522:
523: Else
524:
525: CurrentJobScheduleStartTimeString = ""
526:
527: End If
528:
529: If Len(CurrentJobScheduleEndTime) = 6 Then
530:
531: 'Make nicer looking end time
532: CurrentJobScheduleEndTimeString = Left(CurrentJobScheduleEndTime, 2)
533: CurrentJobScheduleEndTimeString = CurrentJobScheduleEndTimeString & ":"
534: CurrentJobScheduleEndTimeString = CurrentJobScheduleEndTimeString & Mid(CurrentJobScheduleEndTime, 3, 2)
535: CurrentJobScheduleEndTimeString = CurrentJobScheduleEndTimeString & ":"
536: CurrentJobScheduleEndTimeString = CurrentJobScheduleEndTimeString & Mid(CurrentJobScheduleEndTime, 5, 2)
537:
538: Else
539:
540: CurrentJobScheduleEndTimeString = ""
541:
542: End If
543:
544: Select Case CurrentJobScheduleFrequencyTypeID
545: Case 1
546: CurrentJobScheduleFrequencyTypeName = "Once"
547: CurrentJobScheduleFrequencyInterval = ""
548: Case 4
549: CurrentJobScheduleFrequencyTypeName = "Daily"
550: CurrentJobScheduleFrequencyInterval = "Every " & CurrentJobScheduleFrequencyIntervalID & " day(s) "
551: If Len(CurrentJobScheduleStartTimeString) > 0 Then
552: CurrentJobScheduleFrequencyInterval = CurrentJobScheduleFrequencyInterval & "at " & CurrentJobScheduleStartTimeString
553: End If
554:
555: 'For schedules that run more than once per day
556: If CurrentJobScheduleFrequencySubDayType <> 1 Then
557:
558: CurrentJobScheduleFrequencyInterval = "Every " & CurrentJobScheduleFrequencySubDayInterval
559: If CurrentJobScheduleFrequencySubDayType = 4 Then
560: CurrentJobScheduleFrequencyInterval = CurrentJobScheduleFrequencyInterval & " minute(s) "
561: End If
562: If CurrentJobScheduleFrequencySubDayType = 8 Then
563: CurrentJobScheduleFrequencyInterval = CurrentJobScheduleFrequencyInterval & " hour(s) "
564: End If
565:
566: CurrentJobScheduleFrequencyInterval = CurrentJobScheduleFrequencyInterval & " between " & CurrentJobScheduleStartTimeString
567: CurrentJobScheduleFrequencyInterval = CurrentJobScheduleFrequencyInterval & " and " & CurrentJobScheduleEndTimeString
568:
569: End If
570:
571: Case 8
572: CurrentJobScheduleFrequencyInterval = ""
573: CurrentJobScheduleFrequencyTypeName = "Weekly on "
574:
575: 'Determine which days the job runs on
576:
577: 'Sunday
578: Result = CShort(1) And CShort(CurrentJobScheduleFrequencyIntervalID)
579: If Result = 1 Then
580: CurrentJobScheduleFrequencyTypeName = CurrentJobScheduleFrequencyTypeName & "Sunday, "
581: End If
582:
583: 'Monday
584: Result = CShort(2) And CShort(CurrentJobScheduleFrequencyIntervalID)
585: If Result = 2 Then
586: CurrentJobScheduleFrequencyTypeName = CurrentJobScheduleFrequencyTypeName & "Monday, "
587: End If
588:
589: 'Tuesday
590: Result = CShort(4) And CShort(CurrentJobScheduleFrequencyIntervalID)
591: If Result = 4 Then
592: CurrentJobScheduleFrequencyTypeName = CurrentJobScheduleFrequencyTypeName & "Tuesday, "
593: End If
594:
595: 'Wednesday
596: Result = CShort(8) And CShort(CurrentJobScheduleFrequencyIntervalID)
597: If Result = 8 Then
598: CurrentJobScheduleFrequencyTypeName = CurrentJobScheduleFrequencyTypeName & "Wednesday, "
599: End If
600:
601: 'Thursday
602: Result = CShort(16) And CShort(CurrentJobScheduleFrequencyIntervalID)
603: If Result = 16 Then
604: CurrentJobScheduleFrequencyTypeName = CurrentJobScheduleFrequencyTypeName & "Thursday, "
605: End If
606:
607: 'Friday
608: Result = CShort(32) And CShort(CurrentJobScheduleFrequencyIntervalID)
609: If Result = 32 Then
610: CurrentJobScheduleFrequencyTypeName = CurrentJobScheduleFrequencyTypeName & "Friday, "
611: End If
612:
613: 'Saturday
614: Result = CShort(64) And CShort(CurrentJobScheduleFrequencyIntervalID)
615: If Result = 64 Then
616: CurrentJobScheduleFrequencyTypeName = CurrentJobScheduleFrequencyTypeName & "Saturday, "
617: End If
618:
619: If Right(CurrentJobScheduleFrequencyTypeName, 2) = ", " Then
620: CurrentJobScheduleFrequencyTypeName = Left(CurrentJobScheduleFrequencyTypeName, Len(CurrentJobScheduleFrequencyTypeName) - 2)
621: End If
622:
623: 'CurrentJobScheduleFrequencyInterval = "Every " & CurrentJobScheduleFrequencyIntervalID & " day(s) "
624: If Len(CurrentJobScheduleStartTimeString) > 0 Then
625: CurrentJobScheduleFrequencyInterval = CurrentJobScheduleFrequencyInterval & " At " & CurrentJobScheduleStartTimeString
626: End If
627:
628: 'For schedules that run more than once per day
629: If CurrentJobScheduleFrequencySubDayType <> 1 Then
630:
631: CurrentJobScheduleFrequencyInterval = "Every " & CurrentJobScheduleFrequencySubDayInterval
632: If CurrentJobScheduleFrequencySubDayType = 4 Then
633: CurrentJobScheduleFrequencyInterval = CurrentJobScheduleFrequencyInterval & " minute(s) "
634: End If
635: If CurrentJobScheduleFrequencySubDayType = 8 Then
636: CurrentJobScheduleFrequencyInterval = CurrentJobScheduleFrequencyInterval & " hour(s) "
637: End If
638:
639: CurrentJobScheduleFrequencyInterval = CurrentJobScheduleFrequencyInterval & " between " & CurrentJobScheduleStartTimeString
640: CurrentJobScheduleFrequencyInterval = CurrentJobScheduleFrequencyInterval & " and " & CurrentJobScheduleEndTimeString
641:
642: End If
643:
644: Case 16
645: CurrentJobScheduleFrequencyTypeName = "Monthly"
646: CurrentJobScheduleFrequencyInterval = "On the " & CurrentJobScheduleFrequencyIntervalID & " day of the month. "
647:
648: 'For schedules that run more than once per day
649: If CurrentJobScheduleFrequencySubDayType <> 1 Then
650:
651: CurrentJobScheduleFrequencyInterval = CurrentJobScheduleFrequencyInterval & "Every " & CurrentJobScheduleFrequencySubDayInterval
652: If CurrentJobScheduleFrequencySubDayType = 4 Then
653: CurrentJobScheduleFrequencyInterval = CurrentJobScheduleFrequencyInterval & " minute(s) "
654: End If
655: If CurrentJobScheduleFrequencySubDayType = 8 Then
656: CurrentJobScheduleFrequencyInterval = CurrentJobScheduleFrequencyInterval & " hour(s) "
657: End If
658:
659: CurrentJobScheduleFrequencyInterval = CurrentJobScheduleFrequencyInterval & " between " & CurrentJobScheduleStartTimeString
660: CurrentJobScheduleFrequencyInterval = CurrentJobScheduleFrequencyInterval & " and " & CurrentJobScheduleEndTimeString
661:
662: End If
663:
664: Case 32
665: CurrentJobScheduleFrequencyTypeName = "Monthly relative"
666:
667: Select Case CurrentJobScheduleFrequencyRelativeIntervalID
668: Case 0
669: CurrentJobScheduleFrequencyRelativeName = ""
670: Case 1
671: CurrentJobScheduleFrequencyRelativeName = "First "
672: Case 2
673: CurrentJobScheduleFrequencyRelativeName = "Second "
674: Case 4
675: CurrentJobScheduleFrequencyRelativeName = "Third "
676: Case 8
677: CurrentJobScheduleFrequencyRelativeName = "Fourth "
678: Case 16
679: CurrentJobScheduleFrequencyRelativeName = "Last "
680: End Select
681:
682: Select Case CurrentJobScheduleFrequencyIntervalID
683: Case 1
684: CurrentJobScheduleFrequencyInterval = "Every " & CurrentJobScheduleFrequencyRelativeName & "Sunday"
685: Case 2
686: CurrentJobScheduleFrequencyInterval = "Every " & CurrentJobScheduleFrequencyRelativeName & "Monday"
687: Case 3
688: CurrentJobScheduleFrequencyInterval = "Every " & CurrentJobScheduleFrequencyRelativeName & "Tuesday"
689: Case 4
690: CurrentJobScheduleFrequencyInterval = "Every " & CurrentJobScheduleFrequencyRelativeName & "Wednesday"
691: Case 5
692: CurrentJobScheduleFrequencyInterval = "Every " & CurrentJobScheduleFrequencyRelativeName & "Thursday"
693: Case 6
694: CurrentJobScheduleFrequencyInterval = "Every " & CurrentJobScheduleFrequencyRelativeName & "Friday"
695: Case 7
696: CurrentJobScheduleFrequencyInterval = "Every " & CurrentJobScheduleFrequencyRelativeName & "Saturday"
697: Case 8
698: CurrentJobScheduleFrequencyInterval = "Every " & CurrentJobScheduleFrequencyRelativeName & "Day"
699: Case 9
700: CurrentJobScheduleFrequencyInterval = "Every " & CurrentJobScheduleFrequencyRelativeName & "Weekday"
701: Case 10
702: CurrentJobScheduleFrequencyInterval = "Every " & CurrentJobScheduleFrequencyRelativeName & "Saturday and Sunday"
703: Case Else
704: CurrentJobScheduleFrequencyInterval = "Unknown"
705: End Select
706:
707: 'For schedules that run more than once per day
708: If CurrentJobScheduleFrequencySubDayType <> 1 Then
709:
710: CurrentJobScheduleFrequencyInterval = CurrentJobScheduleFrequencyInterval & ". Every " & CurrentJobScheduleFrequencySubDayInterval
711: If CurrentJobScheduleFrequencySubDayType = 4 Then
712: CurrentJobScheduleFrequencyInterval = CurrentJobScheduleFrequencyInterval & " minute(s) "
713: End If
714: If CurrentJobScheduleFrequencySubDayType = 8 Then
715: CurrentJobScheduleFrequencyInterval = CurrentJobScheduleFrequencyInterval & " hour(s) "
716: End If
717:
718: CurrentJobScheduleFrequencyInterval = CurrentJobScheduleFrequencyInterval & " between " & CurrentJobScheduleStartTimeString
719: CurrentJobScheduleFrequencyInterval = CurrentJobScheduleFrequencyInterval & " and " & CurrentJobScheduleEndTimeString
720:
721: End If
722:
723:
724:
725: Case 64
726: CurrentJobScheduleFrequencyTypeName = "Runs when the SQLServerAgent service starts"
727: CurrentJobScheduleFrequencyInterval = ""
728: Case 128
729: CurrentJobScheduleFrequencyTypeName = "Runs when the computer is idle"
730: CurrentJobScheduleFrequencyInterval = ""
731: Case Else
732: CurrentJobScheduleFrequencyTypeName = "Unknown"
733: CurrentJobScheduleFrequencyInterval = ""
734: End Select
735:
736:
737: CurrentJobScheduleName = Replace(CurrentJobScheduleName, "'", "''")
738: CurrentJobScheduleDescription = Replace(CurrentJobScheduleDescription, "'", "''")
739:
740: 'Store this Job Step
741: InsertSQL = "INSERT INTO "
742: InsertSQL = InsertSQL & "t_JobSchedules "
743: InsertSQL = InsertSQL & "( "
744: InsertSQL = InsertSQL & "fk_JobID, "
745: InsertSQL = InsertSQL & "JobScheduleName, "
746: InsertSQL = InsertSQL & "JobScheduleFrequencyType, "
747: InsertSQL = InsertSQL & "JobScheduleFrequencyInterval, "
748: InsertSQL = InsertSQL & "JobScheduleDescription, "
749: InsertSQL = InsertSQL & "JobScheduleCreateDate, "
750: InsertSQL = InsertSQL & "JobScheduleStartDate, "
751: InsertSQL = InsertSQL & "JobScheduleEndDate, "
752: InsertSQL = InsertSQL & "JobScheduleStartTime, "
753: InsertSQL = InsertSQL & "JobScheduleEndTime, "
754: InsertSQL = InsertSQL & "JobScheduleIsEnabled "
755: InsertSQL = InsertSQL & ") values ("
756: InsertSQL = InsertSQL & CurrentJobID & ", "
757: InsertSQL = InsertSQL & "'" & CurrentJobScheduleName & "', "
758: InsertSQL = InsertSQL & "'" & CurrentJobScheduleFrequencyTypeName & "', "
759: InsertSQL = InsertSQL & "'" & CurrentJobScheduleFrequencyInterval & "', "
760: InsertSQL = InsertSQL & "'" & CurrentJobScheduleDescription & "', "
761: InsertSQL = InsertSQL & "'" & CurrentJobScheduleCreateDate & "', "
762: InsertSQL = InsertSQL & "'" & CurrentJobScheduleStartDateString & "', "
763: If CurrentJobScheduleEndDateString = "" Then
764: InsertSQL = InsertSQL & "null, "
765: Else
766: InsertSQL = InsertSQL & "'" & CurrentJobScheduleEndDateString & "', "
767: End If
768: InsertSQL = InsertSQL & "'" & CurrentJobScheduleStartTimeString & "', "
769: InsertSQL = InsertSQL & "'" & CurrentJobScheduleEndTimeString & "', "
770: InsertSQL = InsertSQL & CurrentJobScheduleIsEnabled & " "
771: InsertSQL = InsertSQL & ")"
772:
773: 'InsertSQLResult = DataStore.ExecuteSQL(InsertSQL)
774: CurrentJobScheduleID = DataStore.ExecuteSQLReturnIdentity(InsertSQL)
775:
776:
777: RSJobSchedule.MoveNext()
778: Loop
779:
780: End If
781:
782: End If 'End of Job Schedules
783:
784:
785: RS.MoveNext()
786: Loop
787: End If
788:
789: End If 'End of Jobs
790:
791: End If 'End of ensuring that CurrentProjectDocumentJobs is true
792:
793: DataConnection.Close()
794: ExtractDatabaseSpecificContent = True
795:
796: Call FormMain.DefInstance.UpdateCurrentItem("")
797: Call AppendToLogFile(CurrentLogFileName, "**Data extraction completed for database specific content in server '" & ConnectionDatabaseServer & "'**" & vbCrLf & vbCrLf)
798:
799: End Function
800:
801: Public Function ExtractData(ByRef ProjectID As Integer, ByRef ParseID As Integer, ByRef DatabaseID As Integer, ByRef ConnectionDatabaseName As String, ByRef ConnectionDatabaseServer As String, ByRef ConnectionDatabaseUserName As String, ByRef ConnectionDatabasePassword As String, ByRef UseTrustedConnection As Boolean) As Boolean
802: Dim CurrentFullTextCatalogColumnID As Object
803: Dim CurrentFullTextCatalogColumnColumnName As Object
804: Dim CurrentFullTextCatalogColumnTableName As Object
805: Dim SQLResult As Object
806: Dim CurrentFullTextCatalogTableID As Object
807: Dim CurrentFullTextCatalogIndexName As Object
808: Dim CurrentFullTextCatalogTableName As Object
809: Dim FKColumnID As Object
810: Dim TableName As Object
811: Dim TableID As Object
812: Dim RSTables As Object
813: Dim DataError As Object
814: Dim DatabaseConnectionString As Object
815:
816: Dim SQLServerConnectionString As String
817:
818: If UseTrustedConnection Then
819:
820: SQLServerConnectionString = "Driver={SQL Server};Trusted_Connection=yes;"
821: SQLServerConnectionString = SQLServerConnectionString & "Server=" & ConnectionDatabaseServer & ";"
822: SQLServerConnectionString = SQLServerConnectionString & "Initial Catalog=" & ConnectionDatabaseName & ";"
823: SQLServerConnectionString = SQLServerConnectionString & "Use Procedure for Prepare=1;Auto Translate=True;Packet Size=4096;"
824: SQLServerConnectionString = SQLServerConnectionString & ""
825:
826: FormMain.DefInstance.UpdateStatus(("Using trusted database connection to connect to " & ConnectionDatabaseName))
827: Call AppendToLogFile(CurrentLogFileName, vbTab & "Using trusted database connection to connect to database '" & ConnectionDatabaseName & "'" & vbCrLf)
828:
829: Else
830:
831: SQLServerConnectionString = "Provider=SQLOLEDB.1;Persist Security Info=True;"
832: SQLServerConnectionString = SQLServerConnectionString & "Initial Catalog=" & ConnectionDatabaseName & ";"
833: SQLServerConnectionString = SQLServerConnectionString & "Data Source=" & ConnectionDatabaseServer & ";"
834: SQLServerConnectionString = SQLServerConnectionString & "Use Procedure for Prepare=1;Auto Translate=True;Packet Size=4096;"
835: SQLServerConnectionString = SQLServerConnectionString & "User Id=" & ConnectionDatabaseUserName & ";"
836: SQLServerConnectionString = SQLServerConnectionString & "PASSWORD=" & ConnectionDatabasePassword & ";"
837: SQLServerConnectionString = SQLServerConnectionString & ""
838:
839: FormMain.DefInstance.UpdateStatus(("Using trusted database connection to connect to " & ConnectionDatabaseName))
840: Call AppendToLogFile(CurrentLogFileName, vbTab & "Using SQL login '" & ConnectionDatabaseUserName & "' to connect to database '" & ConnectionDatabaseName & "'" & vbCrLf)
841:
842: End If
843:
844: 'Debug.Print SQLServerConnectionString
845: Call FormMain.DefInstance.UpdateCurrentItem("")
846:
847: Dim DataStore As New DataStoreClass
848: DataStore.SetConnectionString((DatabaseStoreConnectionString))
849:
850: Dim RS As New ADODB.Recordset
851: Dim RS2 As New ADODB.Recordset
852: Dim RS3 As New ADODB.Recordset
853: Dim DataConnection As New ADODB.Connection
854: Dim SQL As String
855: Dim CurrentTableName As String
856: Dim CurrentTableOwner As String
857: Dim CurrentTablePrimaryKeyName As String
858: Dim CurrentTableID As Integer
859: Dim CurrentColumnName As String
860: Dim CurrentColumnID As Integer
861: Dim CurrentColumnNullable As Integer
862: Dim CurrentColumnLength As String
863: Dim CurrentColumnTypeName As String
864: Dim CurrentColumnIsIdentity As Integer
865: Dim CurrentColumnIsPrimaryKey As Integer
866: Dim CurrentColumnDescription As String
867: Dim CurrentColumnPrimarySequence As Integer
868: Dim CurrentStoredProcedureID As Integer
869: Dim CurrentStoredProcedureOwner As String
870: Dim CurrentStoredProcedureColumnName As String
871: Dim CurrentStoredProcedureColumnLength As String
872: Dim CurrentStoredProcedureColumnTypeName As String
873: Dim CurrentTriggerID As Integer
874: Dim CurrentTriggerName As String
875: Dim CurrentTriggerIsUpdate As Integer
876: Dim CurrentTriggerIsDelete As Integer
877: Dim CurrentTriggerIsInsert As Integer
878: 'Dim CurrentTriggerIsAfter As Long
879: 'Dim CurrentTriggerIsInsteadOf As Long
880: Dim CurrentTriggerText As String
881: Dim CurrentViewID As String
882: Dim CurrentViewName As String
883: Dim CurrentViewOwner As String
884: Dim CurrentViewText As String
885: Dim CurrentRelationshipID As Integer
886: Dim CurrentIndexName As String
887: Dim CurrentIndexDescription As String
888: Dim CurrentIndexID As Integer
889: Dim CurrentIndexKeys As String
890: Dim CurrentIndexKeyArray As Object
891: Dim CurrentIndexKey As Object
892: Dim CurrentIndexColumnID As Integer
893: Dim InsertSQL As String
894: Dim InsertSQLResult As Boolean
895: Dim HasDatabaseConnectionError As Boolean
896: Dim HasDatabaseSQLError As Boolean
897: Dim CurrentFullTextCatalogID As Integer
898: Dim CurrentTableColumnsDictionary As New Scripting.Dictionary
899:
900: On Error Resume Next
901:
902: FormMain.DefInstance.UpdateStatus(("Extracting tables and views from database " & ConnectionDatabaseName))
903: Call AppendToLogFile(CurrentLogFileName, vbTab & "Extracting tables and views from database '" & ConnectionDatabaseName & "'" & vbCrLf)
904: 'UPGRADE_WARNING: Couldn't resolve default property of object DatabaseConnectionString. Click for more: 'ms-help://MS.VSCC.2003/commoner/redir/redirect.htm?keyword="vbup1037"'
905: DataConnection.ConnectionString = DatabaseConnectionString
906: DataConnection.Open(SQLServerConnectionString) ', adOpenForwardOnly, adLockReadOnly
907:
908: 'Ensure database can be opened
909: If DataConnection.State = 0 Then
910: FormMain.DefInstance.UpdateStatus(("Cannot open the SQL Server database " & ConnectionDatabaseName))
911: Call AppendToLogFile(CurrentLogFileName, "ERROR: Cannot open the SQL Server database " & ConnectionDatabaseName & vbCrLf)
912:
913: If DataConnection.Errors.Count > 0 Then
914: For Each DataError In DataConnection.Errors
915:
916: 'UPGRADE_WARNING: Couldn't resolve default property of object DataError. Click for more: 'ms-help://MS.VSCC.2003/commoner/redir/redirect.htm?keyword="vbup1037"'
917: Call AppendToLogFile(CurrentLogFileName, vbTab & "ERROR: SQL Server error: " & DataError & vbCrLf)
918:
919: Next DataError
920: End If
921:
922: HasDatabaseConnectionError = True
923: Else
924: HasDatabaseConnectionError = False
925: End If
926:
927: Dim CurrentTablePrimaryKeyColumns As New Scripting.Dictionary
928: Dim PKTableName As String
929: Dim FKTableName As String
930: Dim PKColumnName As String
931: Dim FKColumnName As String
932: Dim PKName As String
933: Dim FKName As String
934: Dim PKColumnID As Integer
935: Dim FKTableID As Integer
936: Dim CurrentStoredProcedureName As String
937: Dim CurrentStoredProcedureText As String
938: Dim SemiColonPos As Integer
939: Dim CurrentFullTextCatalogName As String
940: Dim CurrentFullTextCatalogNumberOfTables As Integer
941: If HasDatabaseConnectionError = False Then
942: SQL = "EXEC " & ConnectionDatabaseName & "..sp_tables"
943: Call AppendToLogFile(CurrentLogFileName, vbTab & "Executing SQL statement: " & SQL & vbCrLf)
944: RS = DataConnection.Execute(SQL)
945:
946: If DataConnection.Errors.Count > 0 Then
947: FormMain.DefInstance.UpdateStatus(("Problem with SQL statement (see log) " & ConnectionDatabaseName))
948: Call AppendToLogFile(CurrentLogFileName, vbTab & "ERROR: Problem executing the SQL statement: " & SQL & vbCrLf)
949:
950: If DataConnection.Errors.Count > 0 Then
951: For Each DataError In DataConnection.Errors
952:
953: 'UPGRADE_WARNING: Couldn't resolve default property of object DataError. Click for more: 'ms-help://MS.VSCC.2003/commoner/redir/redirect.htm?keyword="vbup1037"'
954: Call AppendToLogFile(CurrentLogFileName, vbTab & "ERROR: SQL Server error: " & DataError & vbCrLf)
955:
956: Next DataError
957: End If
958:
959: HasDatabaseSQLError = True
960: Else
961: HasDatabaseSQLError = False
962: End If
963:
964: If HasDatabaseSQLError = False Then
965: Do While Not RS.EOF
966:
967: 'Tables
968: If RS.Fields("TABLE_TYPE").Value = "TABLE" Then
969:
970: CurrentTableName = RS.Fields("TABLE_NAME").Value
971: CurrentTableOwner = UCase(RS.Fields("TABLE_OWNER").Value)
972:
973: If LCase(CurrentTableName) <> "dtproperties" And CurrentTableOwner <> "SYS" And CurrentTableOwner <> "INFORMATION_SCHEMA" Then
974:
975: ' Debug.Print CurrentTableName
976:
977: Call AppendToLogFile(CurrentLogFileName, vbTab & vbTab & "Found table '" & CurrentTableName & "'" & vbCrLf)
978:
979: CurrentTableName = Replace(CurrentTableName, "'", "''")
980:
981: Call FormMain.DefInstance.UpdateCurrentItem(ConnectionDatabaseName & ".." & CurrentTableName)
982:
983: '3.0: Determine the primary keys in this table
984:
985: SQL = "EXEC " & ConnectionDatabaseName & "..sp_pkeys '" & CurrentTableName & "'"
986: Call AppendToLogFile(CurrentLogFileName, vbTab & "Executing SQL statement: " & SQL & vbCrLf)
987: RS2 = DataConnection.Execute(SQL)
988:
989: If DataConnection.Errors.Count > 0 Then
990: FormMain.DefInstance.UpdateStatus(("Problem with SQL statement (see log) " & ConnectionDatabaseName))
991: Call AppendToLogFile(CurrentLogFileName, vbTab & "ERROR: Problem executing the SQL statement: " & SQL & vbCrLf)
992:
993: If DataConnection.Errors.Count > 0 Then
994: For Each DataError In DataConnection.Errors
995:
996: 'UPGRADE_WARNING: Couldn't resolve default property of object DataError. Click for more: 'ms-help://MS.VSCC.2003/commoner/redir/redirect.htm?keyword="vbup1037"'
997: Call AppendToLogFile(CurrentLogFileName, vbTab & "ERROR: SQL Server error: " & DataError & vbCrLf)
998:
999: Next DataError
1000: End If
1001:
1002: HasDatabaseSQLError = True
1003: Else
1004: HasDatabaseSQLError = False
1005: End If
1006:
1007: If HasDatabaseSQLError = False Then
1008: Do While Not RS2.EOF
1009:
1010: CurrentTablePrimaryKeyName = RS2.Fields("PK_NAME").Value
1011: CurrentTablePrimaryKeyColumns.Add(RS2.Fields("COLUMN_NAME").Value, RS2.Fields("KEY_SEQ").Value)
1012:
1013: RS2.MoveNext()
1014: Loop
1015:
1016: End If
1017:
1018:
1019: 'Store this table
1020: InsertSQL = "INSERT INTO "
1021: InsertSQL = InsertSQL & "t_Tables "
1022: InsertSQL = InsertSQL & "( "
1023: InsertSQL = InsertSQL & "fk_ParseID, "
1024: InsertSQL = InsertSQL & "fk_DatabaseID, "
1025: InsertSQL = InsertSQL & "TableName, "
1026: InsertSQL = InsertSQL & "PrimaryKeyName "
1027: InsertSQL = InsertSQL & ") values ("
1028: InsertSQL = InsertSQL & ParseID & ", "
1029: InsertSQL = InsertSQL & DatabaseID & ", "
1030: InsertSQL = InsertSQL & "'" & CurrentTableName & "', "
1031: InsertSQL = InsertSQL & "'" & CurrentTablePrimaryKeyName & "' "
1032: InsertSQL = InsertSQL & ")"
1033:
1034: 'InsertSQLResult = DataStore.ExecuteSQL(InsertSQL)
1035: CurrentTableID = DataStore.ExecuteSQLReturnIdentity(InsertSQL)
1036:
1037: 'Table columns
1038: CurrentTableColumnsDictionary.RemoveAll() 'Clear table columns dictionary
1039:
1040: Call AppendToLogFile(CurrentLogFileName, vbTab & vbTab & "Extracting table columns from database '" & ConnectionDatabaseName & "' table '" & CurrentTableName & "'" & vbCrLf)
1041: SQL = "EXEC " & ConnectionDatabaseName & "..sp_columns '" & CurrentTableName & "'"
1042: Call AppendToLogFile(CurrentLogFileName, vbTab & vbTab & "Executing SQL statement: " & SQL & vbCrLf)
1043: RS2 = DataConnection.Execute(SQL)
1044:
1045: If DataConnection.Errors.Count > 0 Then
1046:
1047: FormMain.DefInstance.UpdateStatus(("Problem with SQL statement (see log) in database " & ConnectionDatabaseName))
1048: Call AppendToLogFile(CurrentLogFileName, vbTab & vbTab & "ERROR: Problem executing the SQL statement: " & SQL & vbCrLf)
1049:
1050: If DataConnection.Errors.Count > 0 Then
1051: For Each DataError In DataConnection.Errors
1052:
1053: 'UPGRADE_WARNING: Couldn't resolve default property of object DataError. Click for more: 'ms-help://MS.VSCC.2003/commoner/redir/redirect.htm?keyword="vbup1037"'
1054: Call AppendToLogFile(CurrentLogFileName, vbTab & vbTab & "ERROR: SQL Server error: " & DataError & vbCrLf)
1055:
1056: Next DataError
1057: End If
1058:
1059: HasDatabaseSQLError = True
1060: Else
1061: HasDatabaseSQLError = False
1062: End If
1063:
1064: If HasDatabaseSQLError = False Then
1065:
1066: Do While Not RS2.EOF
1067:
1068: CurrentColumnName = RS2.Fields("COLUMN_NAME").Value
1069: CurrentColumnNullable = RS2.Fields("NULLABLE").Value
1070: CurrentColumnLength = RS2.Fields("LENGTH").Value
1071: CurrentColumnTypeName = RS2.Fields("TYPE_NAME").Value
1072: 'Debug.Print "CurrentColumnName=" & CurrentColumnName & " null=" & CurrentColumnNullable
1073: CurrentColumnName = Replace(CurrentColumnName, "'", "''")
1074: CurrentColumnTypeName = Replace(CurrentColumnTypeName, "'", "''")
1075:
1076: 'Is this column a primary key?
1077: 'CurrentColumnIdentity
1078: If InStr(UCase(CurrentColumnTypeName), "IDENTITY") > 0 Then
1079: CurrentColumnIsIdentity = 1
1080: Else
1081: CurrentColumnIsIdentity = 0
1082: End If
1083:
1084: Call FormMain.DefInstance.UpdateCurrentItem(ConnectionDatabaseName & ".." & CurrentTableName & "." & CurrentColumnName)
1085:
1086: Call AppendToLogFile(CurrentLogFileName, vbTab & vbTab & vbTab & "Found table column '" & CurrentColumnName & "'" & vbCrLf)
1087:
1088: '3.0: Find column description (only works in SQL server 2000)
1089: 'Note that the following is a bit more efficient as it could be used once for an entire table...
1090: 'use Northwind;SELECT * FROM ::fn_listextendedproperty (NULL, 'user', 'dbo', 'table', 'Customers', 'column', default)
1091: CurrentColumnDescription = ""
1092: If CurrentProjectDocumentTableColumnDescriptions = True Then
1093:
1094: Call AppendToLogFile(CurrentLogFileName, vbTab & vbTab & "Extracting table column description from database '" & ConnectionDatabaseName & "' table '" & CurrentTableName & "' column '" & CurrentColumnName & "'" & vbCrLf)
1095: SQL = "use " & ConnectionDatabaseName & ";"
1096: RS3 = DataConnection.Execute(SQL)
1097: SQL = ""
1098: SQL = SQL & "SELECT * FROM ::fn_listextendedproperty "
1099: SQL = SQL & "(NULL, 'user', 'dbo', 'table', '" & CurrentTableName & "', 'column', default) "
1100: SQL = SQL & "where name = 'MS_Description' and objname = '" & CurrentColumnName & "'"
1101:
1102: Call AppendToLogFile(CurrentLogFileName, vbTab & vbTab & "Executing SQL statement: " & SQL & vbCrLf)
1103: RS3 = DataConnection.Execute(SQL)
1104:
1105: If DataConnection.Errors.Count > 0 Then
1106:
1107: 'FormMain.UpdateStatus ("Problem with SQL statement (see log) in database " & ConnectionDatabaseName)
1108: Call AppendToLogFile(CurrentLogFileName, vbTab & vbTab & "ERROR: Problem executing the SQL statement: " & SQL & vbCrLf)
1109:
1110: If DataConnection.Errors.Count > 0 Then
1111: For Each DataError In DataConnection.Errors
1112:
1113: 'UPGRADE_WARNING: Couldn't resolve default property of object DataError. Click for more: 'ms-help://MS.VSCC.2003/commoner/redir/redirect.htm?keyword="vbup1037"'
1114: Call AppendToLogFile(CurrentLogFileName, vbTab & vbTab & "ERROR: SQL Server error: " & DataError & vbCrLf)
1115:
1116: Next DataError
1117: End If
1118:
1119: HasDatabaseSQLError = True
1120: Else
1121: HasDatabaseSQLError = False
1122: End If
1123:
1124: If HasDatabaseSQLError = False Then
1125:
1126: Do While Not RS3.EOF
1127:
1128: CurrentColumnDescription = RS3.Fields("value").Value
1129:
1130: RS3.MoveNext()
1131:
1132: Loop
1133:
1134: End If
1135:
1136:
1137: End If 'End of column descriptions
1138:
1139: '3.0: Determine if this column is part of the primary key
1140: If CurrentTablePrimaryKeyColumns.Exists(CurrentColumnName) Then
1141: CurrentColumnIsPrimaryKey = True
1142: 'UPGRADE_WARNING: Couldn't resolve default property of object CurrentTablePrimaryKeyColumns(). Click for more: 'ms-help://MS.VSCC.2003/commoner/redir/redirect.htm?keyword="vbup1037"'
1143: CurrentColumnPrimarySequence = CurrentTablePrimaryKeyColumns(CurrentColumnName)
1144: Else
1145: CurrentColumnIsPrimaryKey = False
1146: CurrentColumnPrimarySequence = 0
1147: End If
1148:
1149: 'Store this column
1150: InsertSQL = "INSERT INTO "
1151: InsertSQL = InsertSQL & "t_TableColumns "
1152: InsertSQL = InsertSQL & "( "
1153: InsertSQL = InsertSQL & "fk_TableID, "
1154: InsertSQL = InsertSQL & "IsNullable, "
1155: InsertSQL = InsertSQL & "IsIdentity, "
1156: InsertSQL = InsertSQL & "IsPrimaryKey, "
1157: InsertSQL = InsertSQL & "PrimaryKeySequence, "
1158: InsertSQL = InsertSQL & "Length, "
1159: InsertSQL = InsertSQL & "TypeName, "
1160: InsertSQL = InsertSQL & "ColumnName, "
1161: InsertSQL = InsertSQL & "ColumnDescription "
1162: InsertSQL = InsertSQL & ") values ("
1163: InsertSQL = InsertSQL & CurrentTableID & ", "
1164: InsertSQL = InsertSQL & CurrentColumnNullable & ", "
1165: InsertSQL = InsertSQL & CurrentColumnIsIdentity & ", "
1166: InsertSQL = InsertSQL & CurrentColumnIsPrimaryKey & ", "
1167: InsertSQL = InsertSQL & CurrentColumnPrimarySequence & ", "
1168: InsertSQL = InsertSQL & CurrentColumnLength & ", "
1169: InsertSQL = InsertSQL & "'" & CurrentColumnTypeName & "', "
1170: InsertSQL = InsertSQL & "'" & CurrentColumnName & "', "
1171: InsertSQL = InsertSQL & "'" & CurrentColumnDescription & "'"
1172: InsertSQL = InsertSQL & ")"
1173:
1174: 'InsertSQLResult = DataStore.ExecuteSQL(InsertSQL)
1175: CurrentColumnID = DataStore.ExecuteSQLReturnIdentity(InsertSQL)
1176: CurrentTableColumnsDictionary.Add(CurrentColumnName, CurrentColumnID)
1177:
1178:
1179: RS2.MoveNext()
1180: Loop
1181:
1182: End If
1183:
1184: 'UPGRADE_NOTE: Object CurrentTablePrimaryKeyColumns may not be destroyed until it is garbage collected. Click for more: 'ms-help://MS.VSCC.2003/commoner/redir/redirect.htm?keyword="vbup1029"'
1185: CurrentTablePrimaryKeyColumns = Nothing
1186:
1187: Call AppendToLogFile(CurrentLogFileName, vbCrLf)
1188:
1189: '5:0 Table indexes
1190: Call AppendToLogFile(CurrentLogFileName, vbTab & vbTab & "Extracting indexes from database '" & ConnectionDatabaseName & "' table '" & CurrentTableName & "'" & vbCrLf)
1191: SQL = "EXEC " & ConnectionDatabaseName & "..sp_helpindex '" & CurrentTableName & "'"
1192: Call AppendToLogFile(CurrentLogFileName, vbTab & vbTab & "Executing SQL statement: " & SQL & vbCrLf)
1193: RS2 = DataConnection.Execute(SQL)
1194:
1195: If DataConnection.Errors.Count > 0 Then
1196:
1197: FormMain.DefInstance.UpdateStatus(("Problem with SQL statement (see log) in database " & ConnectionDatabaseName))
1198: Call AppendToLogFile(CurrentLogFileName, vbTab & vbTab & "ERROR: Problem executing the SQL statement: " & SQL & vbCrLf)
1199:
1200: If DataConnection.Errors.Count > 0 Then
1201: For Each DataError In DataConnection.Errors
1202:
1203: 'UPGRADE_WARNING: Couldn't resolve default property of object DataError. Click for more: 'ms-help://MS.VSCC.2003/commoner/redir/redirect.htm?keyword="vbup1037"'
1204: Call AppendToLogFile(CurrentLogFileName, vbTab & vbTab & "ERROR: SQL Server error: " & DataError & vbCrLf)
1205:
1206: Next DataError
1207: End If
1208:
1209: HasDatabaseSQLError = True
1210: Else
1211: HasDatabaseSQLError = False
1212: End If
1213:
1214: If HasDatabaseSQLError = False Then
1215:
1216: Do While Not RS2.EOF
1217:
1218: CurrentIndexName = RS2.Fields("INDEX_NAME").Value
1219: CurrentIndexDescription = RS2.Fields("INDEX_DESCRIPTION").Value
1220: CurrentIndexKeys = RS2.Fields("INDEX_KEYS").Value
1221:
1222: 'Store this table index
1223: InsertSQL = "INSERT INTO "
1224: InsertSQL = InsertSQL & "t_TableIndexes "
1225: InsertSQL = InsertSQL & "( "
1226: InsertSQL = InsertSQL & "fk_TableID, "
1227: InsertSQL = InsertSQL & "IndexName, "
1228: InsertSQL = InsertSQL & "IndexDescription "
1229: InsertSQL = InsertSQL & ") values ("
1230: InsertSQL = InsertSQL & CurrentTableID & ", "
1231: InsertSQL = InsertSQL & "'" & CurrentIndexName & "', "
1232: InsertSQL = InsertSQL & "'" & CurrentIndexDescription & "' "
1233: InsertSQL = InsertSQL & ")"
1234:
1235: CurrentIndexID = DataStore.ExecuteSQLReturnIdentity(InsertSQL)
1236:
1237: 'Split the index keys
1238: 'If InStr(CurrentIndexKeys, ",") > 0 Then
1239: If Len(CurrentIndexKeys) > 0 Then
1240:
1241: 'UPGRADE_WARNING: Couldn't resolve default property of object CurrentIndexKeyArray. Click for more: 'ms-help://MS.VSCC.2003/commoner/redir/redirect.htm?keyword="vbup1037"'
1242: CurrentIndexKeyArray = Split(CurrentIndexKeys, ",")
1243:
1244: For Each CurrentIndexKey In CurrentIndexKeyArray
1245:
1246: 'Determine the ID of this column
1247: 'UPGRADE_WARNING: Couldn't resolve default property of object CurrentIndexKey. Click for more: 'ms-help://MS.VSCC.2003/commoner/redir/redirect.htm?keyword="vbup1037"'
1248: CurrentIndexKey = Trim(CurrentIndexKey)
1249: 'UPGRADE_WARNING: Couldn't resolve default property of object CurrentTableColumnsDictionary(). Click for more: 'ms-help://MS.VSCC.2003/commoner/redir/redirect.htm?keyword="vbup1037"'
1250: CurrentIndexColumnID = CurrentTableColumnsDictionary(CurrentIndexKey)
1251:
1252: 'Store this table index key
1253: InsertSQL = "INSERT INTO "
1254: InsertSQL = InsertSQL & "t_TableIndexColumns "
1255: InsertSQL = InsertSQL & "( "
1256: InsertSQL = InsertSQL & "fk_IndexID, "
1257: InsertSQL = InsertSQL & "fk_ColumnID "
1258: InsertSQL = InsertSQL & ") values ("
1259: InsertSQL = InsertSQL & CurrentIndexID & ", "
1260: InsertSQL = InsertSQL & CurrentIndexColumnID
1261: InsertSQL = InsertSQL & ")"
1262:
1263: InsertSQLResult = DataStore.ExecuteSQL(InsertSQL)
1264:
1265: Next CurrentIndexKey
1266:
1267: End If
1268:
1269: RS2.MoveNext()
1270: Loop
1271:
1272: End If 'End of ensuring HasDatabaseSQLError is false within table indexes
1273:
1274: 'End of table indexes
1275:
1276: 'Table triggers
1277: Call AppendToLogFile(CurrentLogFileName, vbTab & vbTab & "Extracting triggers from database '" & ConnectionDatabaseName & "' table '" & CurrentTableName & "'" & vbCrLf)
1278: SQL = "EXEC " & ConnectionDatabaseName & "..sp_helptrigger '" & CurrentTableName & "'"
1279: Call AppendToLogFile(CurrentLogFileName, vbTab & vbTab & "Executing SQL statement: " & SQL & vbCrLf)
1280: RS2 = DataConnection.Execute(SQL)
1281:
1282: If DataConnection.Errors.Count > 0 Then
1283:
1284: FormMain.DefInstance.UpdateStatus(("Problem with SQL statement (see log) in database " & ConnectionDatabaseName))
1285: Call AppendToLogFile(CurrentLogFileName, vbTab & vbTab & "ERROR: Problem executing the SQL statement: " & SQL & vbCrLf)
1286:
1287: If DataConnection.Errors.Count > 0 Then
1288: For Each DataError In DataConnection.Errors
1289:
1290: 'UPGRADE_WARNING: Couldn't resolve default property of object DataError. Click for more: 'ms-help://MS.VSCC.2003/commoner/redir/redirect.htm?keyword="vbup1037"'
1291: Call AppendToLogFile(CurrentLogFileName, vbTab & vbTab & "ERROR: SQL Server error: " & DataError & vbCrLf)
1292:
1293: Next DataError
1294: End If
1295:
1296: HasDatabaseSQLError = True
1297: Else
1298: HasDatabaseSQLError = False
1299: End If
1300:
1301: If HasDatabaseSQLError = False Then
1302:
1303: Do While Not RS2.EOF
1304:
1305: CurrentTriggerName = RS2.Fields("trigger_name").Value
1306: CurrentTriggerIsUpdate = RS2.Fields("isupdate").Value
1307: CurrentTriggerIsDelete = RS2.Fields("isdelete").Value
1308: CurrentTriggerIsInsert = RS2.Fields("isinsert").Value
1309: 'CurrentTriggerIsAfter = RS2.Fields("isafter")
1310: 'CurrentTriggerIsInsteadOf = RS2.Fields("isinsteadof")
1311:
1312: 'Get the text for this trigger
1313:
1314: Call AppendToLogFile(CurrentLogFileName, vbTab & vbTab & "Retrieving text of trigger '" & CurrentTriggerName & "'" & vbCrLf)
1315: SQL = "EXEC " & ConnectionDatabaseName & "..sp_helptext '" & CurrentTriggerName & "'"
1316: Call AppendToLogFile(CurrentLogFileName, vbTab & vbTab & vbTab & "Executing SQL statement: " & SQL & vbCrLf)
1317:
1318: RS3 = DataConnection.Execute(SQL)
1319:
1320: If DataConnection.Errors.Count > 0 Then
1321:
1322: FormMain.DefInstance.UpdateStatus(("Problem with SQL statement (see log) in database " & ConnectionDatabaseName))
1323: Call AppendToLogFile(CurrentLogFileName, vbTab & vbTab & "ERROR: Problem executing the SQL statement: " & SQL & vbCrLf)
1324:
1325: If DataConnection.Errors.Count > 0 Then
1326: For Each DataError In DataConnection.Errors
1327:
1328: 'UPGRADE_WARNING: Couldn't resolve default property of object DataError. Click for more: 'ms-help://MS.VSCC.2003/commoner/redir/redirect.htm?keyword="vbup1037"'
1329: Call AppendToLogFile(CurrentLogFileName, vbTab & vbTab & "ERROR: SQL Server error: " & DataError & vbCrLf)
1330:
1331: Next DataError
1332: End If
1333:
1334: HasDatabaseSQLError = True
1335: Else
1336: HasDatabaseSQLError = False
1337: End If
1338:
1339: CurrentTriggerText = ""
1340:
1341: If HasDatabaseSQLError = False Then
1342:
1343:
1344: Do While Not RS3.EOF
1345: CurrentTriggerText = CurrentTriggerText & RS3.Fields("Text").Value
1346:
1347: RS3.MoveNext()
1348: Loop
1349:
1350: End If
1351:
1352: CurrentTriggerName = Replace(CurrentTriggerName, "'", "''")
1353: CurrentTriggerText = Replace(CurrentTriggerText, "'", "''")
1354:
1355: Call FormMain.DefInstance.UpdateCurrentItem(ConnectionDatabaseName & ".." & CurrentTriggerName)
1356:
1357: 'Store this trigger
1358: InsertSQL = "INSERT INTO "
1359: InsertSQL = InsertSQL & "t_Triggers "
1360: InsertSQL = InsertSQL & "( "
1361: InsertSQL = InsertSQL & "fk_TableID, "
1362: InsertSQL = InsertSQL & "TriggerName, "
1363: InsertSQL = InsertSQL & "IsInsert, "
1364: InsertSQL = InsertSQL & "IsUpdate, "
1365: InsertSQL = InsertSQL & "IsDelete, "
1366: 'InsertSQL = InsertSQL & "IsAfter, "
1367: 'InsertSQL = InsertSQL & "IsInsteadof, "
1368: InsertSQL = InsertSQL & "TriggerText "
1369: InsertSQL = InsertSQL & ") values ("
1370: InsertSQL = InsertSQL & CurrentTableID & ", "
1371: InsertSQL = InsertSQL & "'" & CurrentTriggerName & "', "
1372: InsertSQL = InsertSQL & CurrentTriggerIsInsert & ", "
1373: InsertSQL = InsertSQL & CurrentTriggerIsUpdate & ", "
1374: InsertSQL = InsertSQL & CurrentTriggerIsDelete & ", "
1375: 'InsertSQL = InsertSQL & CurrentTriggerIsAfter & ", "
1376: 'InsertSQL = InsertSQL & CurrentTriggerIsInsteadOf & ", "
1377: InsertSQL = InsertSQL & "'" & CurrentTriggerText & "'"
1378: InsertSQL = InsertSQL & ")"
1379:
1380: 'InsertSQLResult = DataStore.ExecuteSQL(InsertSQL)
1381: CurrentTriggerID = DataStore.ExecuteSQLReturnIdentity(InsertSQL)
1382:
1383: RS2.MoveNext()
1384: Loop
1385:
1386:
1387:
1388: End If 'End of ensuring HasDatabaseSQLError is false
1389:
1390: End If
1391:
1392:
1393: End If 'End of If RS.Fields("TABLE_TYPE") = "TABLE" Then
1394:
1395: 'Views
1396: If RS.Fields("TABLE_TYPE").Value = "VIEW" Then
1397:
1398: CurrentViewName = RS.Fields("TABLE_NAME").Value
1399: CurrentViewOwner = RS.Fields("TABLE_OWNER").Value
1400:
1401: If LCase(CurrentViewName) <> "dtproperties" And Left(LCase(CurrentViewName), 3) <> "sys" And UCase(CurrentViewOwner) <> "INFORMATION_SCHEMA" Then
1402:
1403: ' Debug.Print CurrentTableName
1404: Call AppendToLogFile(CurrentLogFileName, vbTab & vbTab & "Found view '" & CurrentViewName & "'" & vbCrLf)
1405:
1406: 'Get the text for this view
1407: SQL = "EXEC " & ConnectionDatabaseName & "..sp_helptext '" & CurrentViewName & "'"
1408: Call AppendToLogFile(CurrentLogFileName, vbTab & vbTab & "Retrieving text of view '" & CurrentViewName & "'" & vbCrLf)
1409: Call AppendToLogFile(CurrentLogFileName, vbTab & vbTab & "Executing SQL statement: " & SQL & vbCrLf)
1410:
1411: RS2 = DataConnection.Execute(SQL)
1412:
1413: If DataConnection.Errors.Count > 0 Then
1414:
1415: FormMain.DefInstance.UpdateStatus(("Problem with SQL statement (see log) in database " & ConnectionDatabaseName))
1416: Call AppendToLogFile(CurrentLogFileName, vbTab & vbTab & "ERROR: Problem executing the SQL statement: " & SQL & vbCrLf)
1417:
1418: If DataConnection.Errors.Count > 0 Then
1419: For Each DataError In DataConnection.Errors
1420:
1421: 'UPGRADE_WARNING: Couldn't resolve default property of object DataError. Click for more: 'ms-help://MS.VSCC.2003/commoner/redir/redirect.htm?keyword="vbup1037"'
1422: Call AppendToLogFile(CurrentLogFileName, vbTab & vbTab & "ERROR: SQL Server error: " & DataError & vbCrLf)
1423:
1424: Next DataError
1425: End If
1426:
1427: HasDatabaseSQLError = True
1428: Else
1429: HasDatabaseSQLError = False
1430: End If
1431:
1432: CurrentViewText = ""
1433:
1434: If HasDatabaseSQLError = False Then
1435:
1436: Do While Not RS2.EOF
1437: CurrentViewText = CurrentViewText & RS2.Fields("Text").Value
1438:
1439: RS2.MoveNext()
1440: Loop
1441:
1442: End If
1443:
1444: CurrentViewName = Replace(CurrentViewName, "'", "''")
1445: CurrentViewText = Replace(CurrentViewText, "'", "''")
1446:
1447: Call FormMain.DefInstance.UpdateCurrentItem(ConnectionDatabaseName & ".." & CurrentViewName)
1448:
1449: 'Store this view
1450: InsertSQL = "INSERT INTO "
1451: InsertSQL = InsertSQL & "t_Views "
1452: InsertSQL = InsertSQL & "( "
1453: InsertSQL = InsertSQL & "fk_ParseID, "
1454: InsertSQL = InsertSQL & "fk_DatabaseID, "
1455: InsertSQL = InsertSQL & "ViewName, "
1456: InsertSQL = InsertSQL & "ViewText "
1457: InsertSQL = InsertSQL & ") values ("
1458: InsertSQL = InsertSQL & ParseID & ", "
1459: InsertSQL = InsertSQL & DatabaseID & ", "
1460: InsertSQL = InsertSQL & "'" & CurrentViewName & "', "
1461: InsertSQL = InsertSQL & "'" & CurrentViewText & "'"
1462: InsertSQL = InsertSQL & ")"
1463:
1464: 'InsertSQLResult = DataStore.ExecuteSQL(InsertSQL)
1465: CurrentViewID = CStr(DataStore.ExecuteSQLReturnIdentity(InsertSQL))
1466:
1467: 'View columns
1468: Call AppendToLogFile(CurrentLogFileName, vbTab & vbTab & "Extracting view columns from database '" & ConnectionDatabaseName & "' view '" & CurrentViewName & "'" & vbCrLf)
1469: SQL = "EXEC " & ConnectionDatabaseName & "..sp_columns '" & CurrentTableName & "'"
1470: Call AppendToLogFile(CurrentLogFileName, vbTab & vbTab & "Executing SQL statement: " & SQL & vbCrLf)
1471: RS2 = DataConnection.Execute(SQL)
1472:
1473: If DataConnection.Errors.Count > 0 Then
1474:
1475: FormMain.DefInstance.UpdateStatus(("Problem with SQL statement (see log) in database " & ConnectionDatabaseName))
1476: Call AppendToLogFile(CurrentLogFileName, vbTab & vbTab & "ERROR: Problem executing the SQL statement: " & SQL & vbCrLf)
1477:
1478: If DataConnection.Errors.Count > 0 Then
1479: For Each DataError In DataConnection.Errors
1480:
1481: 'UPGRADE_WARNING: Couldn't resolve default property of object DataError. Click for more: 'ms-help://MS.VSCC.2003/commoner/redir/redirect.htm?keyword="vbup1037"'
1482: Call AppendToLogFile(CurrentLogFileName, vbTab & vbTab & "ERROR: SQL Server error: " & DataError & vbCrLf)
1483:
1484: Next DataError
1485: End If
1486:
1487: HasDatabaseSQLError = True
1488: Else
1489: HasDatabaseSQLError = False
1490: End If
1491:
1492: If HasDatabaseSQLError = False Then
1493:
1494: Do While Not RS2.EOF
1495:
1496: CurrentColumnName = RS2.Fields("COLUMN_NAME").Value
1497: CurrentColumnNullable = RS2.Fields("NULLABLE").Value
1498: CurrentColumnLength = RS2.Fields("LENGTH").Value
1499: CurrentColumnTypeName = RS2.Fields("TYPE_NAME").Value
1500: 'Debug.Print "CurrentColumnName=" & CurrentColumnName & " null=" & CurrentColumnNullable
1501: CurrentColumnName = Replace(CurrentColumnName, "'", "''")
1502: CurrentColumnTypeName = Replace(CurrentColumnTypeName, "'", "''")
1503:
1504: Call AppendToLogFile(CurrentLogFileName, vbTab & vbTab & vbTab & "Found view column '" & CurrentColumnName & "'" & vbCrLf)
1505:
1506: 'Is this column a primary key?
1507: 'CurrentColumnIdentity
1508: If InStr(UCase(CurrentColumnTypeName), "IDENTITY") > 0 Then
1509: CurrentColumnIsPrimaryKey = 1
1510: Else
1511: CurrentColumnIsPrimaryKey = 0
1512: End If
1513:
1514: Call FormMain.DefInstance.UpdateCurrentItem(ConnectionDatabaseName & ".." & CurrentViewName & "." & CurrentColumnName)
1515:
1516: 'Store this column
1517: InsertSQL = "INSERT INTO "
1518: InsertSQL = InsertSQL & "t_ViewColumns "
1519: InsertSQL = InsertSQL & "( "
1520: InsertSQL = InsertSQL & "fk_ViewID, "
1521: InsertSQL = InsertSQL & "IsNullable, "
1522: InsertSQL = InsertSQL & "IsPrimaryKey, "
1523: InsertSQL = InsertSQL & "Length, "
1524: InsertSQL = InsertSQL & "TypeName, "
1525: InsertSQL = InsertSQL & "ColumnName "
1526: InsertSQL = InsertSQL & ") values ("
1527: InsertSQL = InsertSQL & CurrentViewID & ", "
1528: InsertSQL = InsertSQL & CurrentColumnNullable & ", "
1529: InsertSQL = InsertSQL & CurrentColumnIsPrimaryKey & ", "
1530: InsertSQL = InsertSQL & CurrentColumnLength & ", "
1531: InsertSQL = InsertSQL & "'" & CurrentColumnTypeName & "', "
1532: InsertSQL = InsertSQL & "'" & CurrentColumnName & "'"
1533: InsertSQL = InsertSQL & ")"
1534:
1535: 'InsertSQLResult = DataStore.ExecuteSQL(InsertSQL)
1536: CurrentColumnID = DataStore.ExecuteSQLReturnIdentity(InsertSQL)
1537:
1538:
1539: RS2.MoveNext()
1540: Loop
1541:
1542: End If 'End of HasDatabaseSQLError is false
1543:
1544: Call AppendToLogFile(CurrentLogFileName, vbCrLf)
1545:
1546:
1547: End If
1548:
1549:
1550: End If 'End of If RS.Fields("TABLE_TYPE") = "VIEW" Then
1551:
1552: RS.MoveNext()
1553: Loop 'End of Tables
1554:
1555: End If 'end of ensuring no SQL error
1556:
1557: 'Table relationships - for this we need to iterate through the tables found
1558: FormMain.DefInstance.UpdateStatus(("Extracting table relationships from database " & ConnectionDatabaseName))
1559: Call AppendToLogFile(CurrentLogFileName, vbTab & "Extracting table relationships from database '" & ConnectionDatabaseName & "'" & vbCrLf)
1560:
1561: SQL = "SELECT t_Tables.* "
1562: SQL = SQL & "FROM t_Tables "
1563: SQL = SQL & "WHERE "
1564: SQL = SQL & "fk_ParseID = " & ParseID
1565: SQL = SQL & " AND fk_DatabaseID = " & DatabaseID
1566: RSTables = DataStore.GetRecordSet(SQL)
1567:
1568: 'UPGRADE_WARNING: Couldn't resolve default property of object RSTables.EOF. Click for more: 'ms-help://MS.VSCC.2003/commoner/redir/redirect.htm?keyword="vbup1037"'
1569: Do While Not RSTables.EOF
1570:
1571: 'UPGRADE_WARNING: Couldn't resolve default property of object RSTables.Fields. Click for more: 'ms-help://MS.VSCC.2003/commoner/redir/redirect.htm?keyword="vbup1037"'
1572: 'UPGRADE_WARNING: Couldn't resolve default property of object TableID. Click for more: 'ms-help://MS.VSCC.2003/commoner/redir/redirect.htm?keyword="vbup1037"'
1573: TableID = RSTables.Fields("TableID").Value
1574: 'UPGRADE_WARNING: Couldn't resolve default property of object RSTables.Fields. Click for more: 'ms-help://MS.VSCC.2003/commoner/redir/redirect.htm?keyword="vbup1037"'
1575: 'UPGRADE_WARNING: Couldn't resolve default property of object TableName. Click for more: 'ms-help://MS.VSCC.2003/commoner/redir/redirect.htm?keyword="vbup1037"'
1576: TableName = RSTables.Fields("TableName").Value
1577:
1578: 'UPGRADE_WARNING: Couldn't resolve default property of object TableName. Click for more: 'ms-help://MS.VSCC.2003/commoner/redir/redirect.htm?keyword="vbup1037"'
1579: SQL = "EXEC " & ConnectionDatabaseName & "..sp_fkeys '" & TableName & "'"
1580: Call AppendToLogFile(CurrentLogFileName, vbTab & vbTab & "Executing SQL statement: " & SQL & vbCrLf)
1581:
1582: RS = DataConnection.Execute(SQL)
1583:
1584: If DataConnection.Errors.Count > 0 Then
1585:
1586: FormMain.DefInstance.UpdateStatus(("Problem with SQL statement (see log) in database " & ConnectionDatabaseName))
1587: Call AppendToLogFile(CurrentLogFileName, vbTab & vbTab & "ERROR: Problem executing the SQL statement: " & SQL & vbCrLf)
1588:
1589: If DataConnection.Errors.Count > 0 Then
1590: For Each DataError In DataConnection.Errors
1591:
1592: 'UPGRADE_WARNING: Couldn't resolve default property of object DataError. Click for more: 'ms-help://MS.VSCC.2003/commoner/redir/redirect.htm?keyword="vbup1037"'
1593: Call AppendToLogFile(CurrentLogFileName, vbTab & vbTab & "ERROR: SQL Server error: " & DataError & vbCrLf)
1594:
1595: Next DataError
1596: End If
1597:
1598: HasDatabaseSQLError = True
1599:
1600: Else
1601:
1602: HasDatabaseSQLError = False
1603:
1604: End If
1605:
1606: If HasDatabaseSQLError = False Then
1607:
1608:
1609: Do While Not RS.EOF
1610:
1611: PKTableName = RS.Fields("PKTABLE_NAME").Value
1612: FKTableName = RS.Fields("FKTABLE_NAME").Value
1613: PKColumnName = RS.Fields("PKCOLUMN_NAME").Value
1614: FKColumnName = RS.Fields("FKCOLUMN_NAME").Value
1615: PKName = RS.Fields("PK_NAME").Value
1616: FKName = RS.Fields("FK_NAME").Value
1617:
1618: PKName = Replace(PKName, "'", "''")
1619: FKName = Replace(FKName, "'", "''")
1620:
1621: 'Find out which primary and foreign keys these are
1622: 'UPGRADE_WARNING: Couldn't resolve default property of object TableID. Click for more: 'ms-help://MS.VSCC.2003/commoner/redir/redirect.htm?keyword="vbup1037"'
1623: SQL = "SELECT ColumnID FROM t_TableColumns WHERE fk_TableID = " & TableID & " AND ColumnName = '" & PKColumnName & "'"
1624: PKColumnID = CInt(DataStore.ExecuteSQLReturnSingleValue(SQL, "ColumnID"))
1625:
1626: SQL = "SELECT TableID FROM t_Tables WHERE TableName = '" & FKTableName & "' AND fk_ParseID = " & ParseID & " AND fk_DatabaseID = " & DatabaseID
1627: FKTableID = CInt(DataStore.ExecuteSQLReturnSingleValue(SQL, "TableID"))
1628:
1629: SQL = "SELECT ColumnID FROM t_TableColumns WHERE fk_TableID = " & FKTableID & " AND ColumnName = '" & FKColumnName & "'"
1630: 'UPGRADE_WARNING: Couldn't resolve default property of object FKColumnID. Click for more: 'ms-help://MS.VSCC.2003/commoner/redir/redirect.htm?keyword="vbup1037"'
1631: FKColumnID = DataStore.ExecuteSQLReturnSingleValue(SQL, "ColumnID")
1632:
1633: 'Store this relationship
1634: InsertSQL = "INSERT INTO "
1635: InsertSQL = InsertSQL & "t_TableRelationships "
1636: InsertSQL = InsertSQL & "( "
1637: InsertSQL = InsertSQL & "fk_PrimaryKeyColumnID, "
1638: InsertSQL = InsertSQL & "fk_ForeignKeyColumnID, "
1639: InsertSQL = InsertSQL & "PrimaryKeyName, "
1640: InsertSQL = InsertSQL & "ForeignKeyName "
1641: InsertSQL = InsertSQL & ") values ("
1642: InsertSQL = InsertSQL & PKColumnID & ", "
1643: 'UPGRADE_WARNING: Couldn't resolve default property of object FKColumnID. Click for more: 'ms-help://MS.VSCC.2003/commoner/redir/redirect.htm?keyword="vbup1037"'
1644: InsertSQL = InsertSQL & FKColumnID & ", "
1645: InsertSQL = InsertSQL & "'" & PKName & "', "
1646: InsertSQL = InsertSQL & "'" & FKName & "'"
1647: InsertSQL = InsertSQL & ")"
1648:
1649: 'InsertSQLResult = DataStore.ExecuteSQL(InsertSQL)
1650: CurrentRelationshipID = DataStore.ExecuteSQLReturnIdentity(InsertSQL)
1651:
1652: RS.MoveNext()
1653: Loop
1654:
1655: End If 'End of HasDatabaseSQLError is false
1656:
1657:
1658: 'UPGRADE_WARNING: Couldn't resolve default property of object RSTables.MoveNext. Click for more: 'ms-help://MS.VSCC.2003/commoner/redir/redirect.htm?keyword="vbup1037"'
1659: RSTables.MoveNext()
1660: Loop
1661: 'End of table relationships
1662:
1663: FormMain.DefInstance.UpdateStatus(("Extracting stored procedures from database " & ConnectionDatabaseName))
1664:
1665: Call AppendToLogFile(CurrentLogFileName, vbTab & "Extracting stored procedures from database '" & ConnectionDatabaseName & "'" & vbCrLf)
1666: SQL = "EXEC " & ConnectionDatabaseName & "..sp_stored_procedures"
1667: Call AppendToLogFile(CurrentLogFileName, vbTab & vbTab & "Executing SQL statement: " & SQL & vbCrLf)
1668:
1669: RS = DataConnection.Execute(SQL)
1670:
1671: If DataConnection.Errors.Count > 0 Then
1672:
1673: FormMain.DefInstance.UpdateStatus(("Problem with SQL statement (see log) in database " & ConnectionDatabaseName))
1674: Call AppendToLogFile(CurrentLogFileName, vbTab & vbTab & "ERROR: Problem executing the SQL statement: " & SQL & vbCrLf)
1675:
1676: If DataConnection.Errors.Count > 0 Then
1677: For Each DataError In DataConnection.Errors
1678:
1679: 'UPGRADE_WARNING: Couldn't resolve default property of object DataError. Click for more: 'ms-help://MS.VSCC.2003/commoner/redir/redirect.htm?keyword="vbup1037"'
1680: Call AppendToLogFile(CurrentLogFileName, vbTab & vbTab & "ERROR: SQL Server error: " & DataError & vbCrLf)
1681:
1682: Next DataError
1683: End If
1684:
1685: HasDatabaseSQLError = True
1686:
1687: Else
1688:
1689: HasDatabaseSQLError = False
1690:
1691: End If
1692:
1693: If HasDatabaseSQLError = False Then
1694:
1695:
1696: Do While Not RS.EOF
1697: CurrentStoredProcedureName = RS.Fields("PROCEDURE_NAME").Value
1698: CurrentStoredProcedureOwner = UCase(RS.Fields("PROCEDURE_OWNER").Value)
1699:
1700: 'Replace anything after a ';'
1701: SemiColonPos = InStr(CurrentStoredProcedureName, ";")
1702: If SemiColonPos > 0 Then
1703: CurrentStoredProcedureName = Left(CurrentStoredProcedureName, SemiColonPos - 1)
1704: End If
1705:
1706: 'Store this stored procedure
1707: If Left(LCase(CurrentStoredProcedureName), 3) <> "dt_" And CurrentStoredProcedureOwner <> "SYS" Then
1708:
1709: 'Get the text for this stored procedure
1710: Call AppendToLogFile(CurrentLogFileName, vbTab & vbTab & "Retrieving text of stored procedure '" & CurrentStoredProcedureName & "'" & vbCrLf)
1711: SQL = "EXEC " & ConnectionDatabaseName & "..sp_helptext '" & CurrentStoredProcedureName & "'"
1712: Call AppendToLogFile(CurrentLogFileName, vbTab & vbTab & "Executing SQL statement: " & SQL & vbCrLf)
1713:
1714: RS2 = DataConnection.Execute(SQL)
1715:
1716: If DataConnection.Errors.Count > 0 Then
1717:
1718: FormMain.DefInstance.UpdateStatus(("Problem with SQL statement (see log) in database " & ConnectionDatabaseName))
1719: Call AppendToLogFile(CurrentLogFileName, vbTab & vbTab & "ERROR: Problem executing the SQL statement: " & SQL & vbCrLf)
1720:
1721: If DataConnection.Errors.Count > 0 Then
1722: For Each DataError In DataConnection.Errors
1723:
1724: 'UPGRADE_WARNING: Couldn't resolve default property of object DataError. Click for more: 'ms-help://MS.VSCC.2003/commoner/redir/redirect.htm?keyword="vbup1037"'
1725: Call AppendToLogFile(CurrentLogFileName, vbTab & vbTab & "ERROR: SQL Server error: " & DataError & vbCrLf)
1726:
1727: Next DataError
1728: End If
1729:
1730: HasDatabaseSQLError = True
1731:
1732: Else
1733:
1734: HasDatabaseSQLError = False
1735:
1736: End If
1737:
1738: If HasDatabaseSQLError = False Then
1739:
1740: CurrentStoredProcedureText = ""
1741: Do While Not RS2.EOF
1742: CurrentStoredProcedureText = CurrentStoredProcedureText & RS2.Fields("Text").Value
1743:
1744: RS2.MoveNext()
1745: Loop
1746:
1747: End If
1748:
1749: CurrentStoredProcedureText = Replace(CurrentStoredProcedureText, "'", "''")
1750: 'CurrentStoredProcedureText = DataConnection.ExecuteSQLReturnSingleValue(SQL, "Text")
1751: 'CurrentStoredProcedureText = Replace(CurrentStoredProcedureText, "'", "''")
1752:
1753: Call FormMain.DefInstance.UpdateCurrentItem(ConnectionDatabaseName & ".." & CurrentStoredProcedureName)
1754:
1755: InsertSQL = "INSERT INTO "
1756: InsertSQL = InsertSQL & "t_StoredProcedures "
1757: InsertSQL = InsertSQL & "( "
1758: InsertSQL = InsertSQL & "fk_ParseID, "
1759: InsertSQL = InsertSQL & "fk_DatabaseID, "
1760: InsertSQL = InsertSQL & "StoredProcedureName, "
1761: InsertSQL = InsertSQL & "StoredProcedureText"
1762: InsertSQL = InsertSQL & ") values ("
1763: InsertSQL = InsertSQL & ParseID & ", "
1764: InsertSQL = InsertSQL & DatabaseID & ", "
1765: InsertSQL = InsertSQL & "'" & CurrentStoredProcedureName & "', "
1766: InsertSQL = InsertSQL & "'" & CurrentStoredProcedureText & "'"
1767: InsertSQL = InsertSQL & ")"
1768:
1769: CurrentStoredProcedureID = DataStore.ExecuteSQLReturnIdentity(InsertSQL)
1770: ' CurrentColumnID = DataStore.ExecuteSQLReturnIdentity(InsertSQL)
1771:
1772: 'Stored procedure columns
1773: Call AppendToLogFile(CurrentLogFileName, vbTab & vbTab & "Extracting stored procedure columns from database '" & ConnectionDatabaseName & "' stored procedure '" & CurrentStoredProcedureName & "'" & vbCrLf)
1774: SQL = "EXEC " & ConnectionDatabaseName & "..sp_sproc_columns '" & CurrentStoredProcedureName & "'"
1775: Call AppendToLogFile(CurrentLogFileName, vbTab & vbTab & "Executing SQL statement: " & SQL & vbCrLf)
1776: RS2 = DataConnection.Execute(SQL)
1777:
1778: If DataConnection.Errors.Count > 0 Then
1779:
1780: FormMain.DefInstance.UpdateStatus(("Problem with SQL statement (see log) in database " & ConnectionDatabaseName))
1781: Call AppendToLogFile(CurrentLogFileName, vbTab & vbTab & "ERROR: Problem executing the SQL statement: " & SQL & vbCrLf)
1782:
1783: If DataConnection.Errors.Count > 0 Then
1784: For Each DataError In DataConnection.Errors
1785:
1786: 'UPGRADE_WARNING: Couldn't resolve default property of object DataError. Click for more: 'ms-help://MS.VSCC.2003/commoner/redir/redirect.htm?keyword="vbup1037"'
1787: Call AppendToLogFile(CurrentLogFileName, vbTab & vbTab & "ERROR: SQL Server error: " & DataError & vbCrLf)
1788:
1789: Next DataError
1790: End If
1791:
1792: HasDatabaseSQLError = True
1793:
1794: Else
1795:
1796: HasDatabaseSQLError = False
1797:
1798: End If
1799:
1800: If HasDatabaseSQLError = False Then
1801:
1802: Do While Not RS2.EOF
1803:
1804: CurrentStoredProcedureColumnName = RS2.Fields("COLUMN_NAME").Value
1805: CurrentStoredProcedureColumnLength = RS2.Fields("LENGTH").Value
1806: CurrentStoredProcedureColumnTypeName = RS2.Fields("TYPE_NAME").Value
1807: CurrentStoredProcedureColumnName = Replace(CurrentStoredProcedureColumnName, "'", "''")
1808: CurrentStoredProcedureColumnTypeName = Replace(CurrentStoredProcedureColumnTypeName, "'", "''")
1809:
1810: Call AppendToLogFile(CurrentLogFileName, vbTab & vbTab & vbTab & "Found stored procedure column '" & CurrentStoredProcedureColumnName & "'" & vbCrLf)
1811:
1812: 'Store this column
1813: InsertSQL = "INSERT INTO "
1814: InsertSQL = InsertSQL & "t_StoredProcedureColumns "
1815: InsertSQL = InsertSQL & "( "
1816: InsertSQL = InsertSQL & "fk_StoredProcedureID, "
1817: InsertSQL = InsertSQL & "StoredProcedureColumnName, "
1818: InsertSQL = InsertSQL & "StoredProcedureColumnTypeName, "
1819: InsertSQL = InsertSQL & "StoredProcedureColumnLength "
1820: InsertSQL = InsertSQL & ") values ("
1821: InsertSQL = InsertSQL & CurrentStoredProcedureID & ", "
1822: InsertSQL = InsertSQL & "'" & CurrentStoredProcedureColumnName & "', "
1823: InsertSQL = InsertSQL & "'" & CurrentStoredProcedureColumnTypeName & "', "
1824: InsertSQL = InsertSQL & "'" & CurrentStoredProcedureColumnLength & "'"
1825: InsertSQL = InsertSQL & ")"
1826:
1827: 'InsertSQLResult = DataStore.ExecuteSQL(InsertSQL)
1828: CurrentColumnID = DataStore.ExecuteSQLReturnIdentity(InsertSQL)
1829:
1830: RS2.MoveNext()
1831: Loop
1832:
1833: End If
1834:
1835: Call AppendToLogFile(CurrentLogFileName, vbCrLf)
1836:
1837: End If
1838:
1839: ' Debug.Print CurrentStoredProcedureName
1840:
1841: RS.MoveNext()
1842: Loop 'End of Stored Procedures
1843:
1844: 'Start of full-text catalogs
1845: FormMain.DefInstance.UpdateStatus(("Extracting full-text catalogs from database " & ConnectionDatabaseName))
1846:
1847: Call AppendToLogFile(CurrentLogFileName, vbTab & "Extracting full-text catalogs from database '" & ConnectionDatabaseName & "'" & vbCrLf)
1848: SQL = "EXEC " & ConnectionDatabaseName & "..sp_help_fulltext_catalogs"
1849: Call AppendToLogFile(CurrentLogFileName, vbTab & vbTab & "Executing SQL statement: " & SQL & vbCrLf)
1850:
1851: RS = DataConnection.Execute(SQL)
1852:
1853: If DataConnection.Errors.Count > 0 Then
1854:
1855: FormMain.DefInstance.UpdateStatus(("Problem with SQL statement (see log) in database " & ConnectionDatabaseName))
1856: Call AppendToLogFile(CurrentLogFileName, vbTab & vbTab & "ERROR: Problem executing the SQL statement: " & SQL & vbCrLf)
1857:
1858: If DataConnection.Errors.Count > 0 Then
1859: For Each DataError In DataConnection.Errors
1860:
1861: 'UPGRADE_WARNING: Couldn't resolve default property of object DataError. Click for more: 'ms-help://MS.VSCC.2003/commoner/redir/redirect.htm?keyword="vbup1037"'
1862: Call AppendToLogFile(CurrentLogFileName, vbTab & vbTab & "ERROR: SQL Server error: " & DataError & vbCrLf)
1863:
1864: Next DataError
1865: End If
1866:
1867: HasDatabaseSQLError = True
1868:
1869: Else
1870:
1871: HasDatabaseSQLError = False
1872:
1873: End If
1874:
1875: If HasDatabaseSQLError = False Then
1876:
1877:
1878: Do While Not RS.EOF
1879:
1880: CurrentFullTextCatalogName = RS.Fields("NAME").Value
1881: CurrentFullTextCatalogNumberOfTables = RS.Fields("NUMBER_FULLTEXT_TABLES").Value
1882:
1883: CurrentFullTextCatalogName = Replace(CurrentFullTextCatalogName, "'", "''")
1884:
1885: Call FormMain.DefInstance.UpdateCurrentItem(ConnectionDatabaseName & ".." & CurrentFullTextCatalogName)
1886:
1887: InsertSQL = "INSERT INTO "
1888: InsertSQL = InsertSQL & "t_FullTextCatalogs "
1889: InsertSQL = InsertSQL & "( "
1890: InsertSQL = InsertSQL & "fk_ParseID, "
1891: InsertSQL = InsertSQL & "fk_DatabaseID, "
1892: InsertSQL = InsertSQL & "FullTextCatalogName, "
1893: InsertSQL = InsertSQL & "FullTextCatalogNumberOfTables"
1894: InsertSQL = InsertSQL & ") values ("
1895: InsertSQL = InsertSQL & ParseID & ", "
1896: InsertSQL = InsertSQL & DatabaseID & ", "
1897: InsertSQL = InsertSQL & "'" & CurrentFullTextCatalogName & "', "
1898: InsertSQL = InsertSQL & CurrentFullTextCatalogNumberOfTables & " "
1899: InsertSQL = InsertSQL & ")"
1900:
1901: CurrentFullTextCatalogID = DataStore.ExecuteSQLReturnIdentity(InsertSQL)
1902:
1903: 'Determine the tables in this full text catalog
1904: Call AppendToLogFile(CurrentLogFileName, vbTab & vbTab & "Extracting full-text catalog tables from database '" & ConnectionDatabaseName & "' full-text catalog '" & CurrentFullTextCatalogName & "'" & vbCrLf)
1905: SQL = "EXEC " & ConnectionDatabaseName & "..sp_help_fulltext_tables '" & CurrentFullTextCatalogName & "'"
1906: Call AppendToLogFile(CurrentLogFileName, vbTab & vbTab & "Executing SQL statement: " & SQL & vbCrLf)
1907: RS2 = DataConnection.Execute(SQL)
1908:
1909: If DataConnection.Errors.Count > 0 Then
1910:
1911: FormMain.DefInstance.UpdateStatus(("Problem with SQL statement (see log) in database " & ConnectionDatabaseName))
1912: Call AppendToLogFile(CurrentLogFileName, vbTab & vbTab & "ERROR: Problem executing the SQL statement: " & SQL & vbCrLf)
1913:
1914: If DataConnection.Errors.Count > 0 Then
1915: For Each DataError In DataConnection.Errors
1916:
1917: 'UPGRADE_WARNING: Couldn't resolve default property of object DataError. Click for more: 'ms-help://MS.VSCC.2003/commoner/redir/redirect.htm?keyword="vbup1037"'
1918: Call AppendToLogFile(CurrentLogFileName, vbTab & vbTab & "ERROR: SQL Server error: " & DataError & vbCrLf)
1919:
1920: Next DataError
1921: End If
1922:
1923: HasDatabaseSQLError = True
1924:
1925: Else
1926:
1927: HasDatabaseSQLError = False
1928:
1929: End If
1930:
1931: If HasDatabaseSQLError = False Then
1932:
1933: Do While Not RS2.EOF
1934:
1935: 'UPGRADE_WARNING: Couldn't resolve default property of object CurrentFullTextCatalogTableName. Click for more: 'ms-help://MS.VSCC.2003/commoner/redir/redirect.htm?keyword="vbup1037"'
1936: CurrentFullTextCatalogTableName = RS2.Fields("TABLE_NAME").Value
1937: 'UPGRADE_WARNING: Couldn't resolve default property of object CurrentFullTextCatalogIndexName. Click for more: 'ms-help://MS.VSCC.2003/commoner/redir/redirect.htm?keyword="vbup1037"'
1938: CurrentFullTextCatalogIndexName = RS2.Fields("FULLTEXT_KEY_INDEX_NAME").Value
1939:
1940: 'Determine which table this is
1941: 'UPGRADE_WARNING: Couldn't resolve default property of object CurrentFullTextCatalogTableName. Click for more: 'ms-help://MS.VSCC.2003/commoner/redir/redirect.htm?keyword="vbup1037"'
1942: SQL = "SELECT TableID FROM t_Tables WHERE TableName = '" & CurrentFullTextCatalogTableName & "' AND fk_DatabaseID = " & DatabaseID & " AND fk_ParseID = " & ParseID
1943: 'UPGRADE_WARNING: Couldn't resolve default property of object CurrentFullTextCatalogTableID. Click for more: 'ms-help://MS.VSCC.2003/commoner/redir/redirect.htm?keyword="vbup1037"'
1944: CurrentFullTextCatalogTableID = DataStore.ExecuteSQLReturnSingleValue(SQL, "TableID")
1945:
1946: 'UPGRADE_WARNING: Couldn't resolve default property of object CurrentFullTextCatalogTableID. Click for more: 'ms-help://MS.VSCC.2003/commoner/redir/redirect.htm?keyword="vbup1037"'
1947: If CurrentFullTextCatalogTableID > 0 Then
1948: 'Store this full-text catalog table
1949: InsertSQL = "INSERT INTO "
1950: InsertSQL = InsertSQL & "t_FullTextCatalogsTables "
1951: InsertSQL = InsertSQL & "( "
1952: InsertSQL = InsertSQL & "fk_FullTextCatalogID, "
1953: InsertSQL = InsertSQL & "fk_TableID, "
1954: InsertSQL = InsertSQL & "FullTextCatalogTableIndexName"
1955: InsertSQL = InsertSQL & ") values ("
1956: InsertSQL = InsertSQL & CurrentFullTextCatalogID & ", "
1957: 'UPGRADE_WARNING: Couldn't resolve default property of object CurrentFullTextCatalogTableID. Click for more: 'ms-help://MS.VSCC.2003/commoner/redir/redirect.htm?keyword="vbup1037"'
1958: InsertSQL = InsertSQL & CurrentFullTextCatalogTableID & ", "
1959: 'UPGRADE_WARNING: Couldn't resolve default property of object CurrentFullTextCatalogIndexName. Click for more: 'ms-help://MS.VSCC.2003/commoner/redir/redirect.htm?keyword="vbup1037"'
1960: InsertSQL = InsertSQL & "'" & CurrentFullTextCatalogIndexName & "'"
1961: InsertSQL = InsertSQL & ")"
1962:
1963: 'UPGRADE_WARNING: Couldn't resolve default property of object SQLResult. Click for more: 'ms-help://MS.VSCC.2003/commoner/redir/redirect.htm?keyword="vbup1037"'
1964: SQLResult = DataStore.ExecuteSQL(InsertSQL)
1965:
1966: End If
1967:
1968: 'Determine which table columns are in the full-text catalog
1969: 't_FullTextCatalogsColumns
1970: 'UPGRADE_WARNING: Couldn't resolve default property of object CurrentFullTextCatalogTableName. Click for more: 'ms-help://MS.VSCC.2003/commoner/redir/redirect.htm?keyword="vbup1037"'
1971: Call AppendToLogFile(CurrentLogFileName, vbTab & vbTab & "Extracting full-text catalog table columns from database '" & ConnectionDatabaseName & "' table '" & CurrentFullTextCatalogTableName & "'" & vbCrLf)
1972: 'UPGRADE_WARNING: Couldn't resolve default property of object CurrentFullTextCatalogTableName. Click for more: 'ms-help://MS.VSCC.2003/commoner/redir/redirect.htm?keyword="vbup1037"'
1973: SQL = "EXEC " & ConnectionDatabaseName & "..sp_help_fulltext_columns '" & CurrentFullTextCatalogTableName & "'"
1974: Call AppendToLogFile(CurrentLogFileName, vbTab & vbTab & "Executing SQL statement: " & SQL & vbCrLf)
1975: RS3 = DataConnection.Execute(SQL)
1976:
1977: If DataConnection.Errors.Count > 0 Then
1978:
1979: FormMain.DefInstance.UpdateStatus(("Problem with SQL statement (see log) in database " & ConnectionDatabaseName))
1980: Call AppendToLogFile(CurrentLogFileName, vbTab & vbTab & "ERROR: Problem executing the SQL statement: " & SQL & vbCrLf)
1981:
1982: If DataConnection.Errors.Count > 0 Then
1983: For Each DataError In DataConnection.Errors
1984:
1985: 'UPGRADE_WARNING: Couldn't resolve default property of object DataError. Click for more: 'ms-help://MS.VSCC.2003/commoner/redir/redirect.htm?keyword="vbup1037"'
1986: Call AppendToLogFile(CurrentLogFileName, vbTab & vbTab & "ERROR: SQL Server error: " & DataError & vbCrLf)
1987:
1988: Next DataError
1989: End If
1990:
1991: HasDatabaseSQLError = True
1992:
1993: Else
1994:
1995: HasDatabaseSQLError = False
1996:
1997: End If
1998:
1999: If HasDatabaseSQLError = False Then
2000:
2001: Do While Not RS3.EOF
2002:
2003: 'UPGRADE_WARNING: Couldn't resolve default property of object CurrentFullTextCatalogColumnTableName. Click for more: 'ms-help://MS.VSCC.2003/commoner/redir/redirect.htm?keyword="vbup1037"'
2004: CurrentFullTextCatalogColumnTableName = RS3.Fields("TABLE_NAME").Value
2005: 'UPGRADE_WARNING: Couldn't resolve default property of object CurrentFullTextCatalogColumnColumnName. Click for more: 'ms-help://MS.VSCC.2003/commoner/redir/redirect.htm?keyword="vbup1037"'
2006: CurrentFullTextCatalogColumnColumnName = RS3.Fields("FULLTEXT_COLUMN_NAME").Value
2007:
2008: 'UPGRADE_WARNING: Couldn't resolve default property of object CurrentFullTextCatalogTableName. Click for more: 'ms-help://MS.VSCC.2003/commoner/redir/redirect.htm?keyword="vbup1037"'
2009: 'UPGRADE_WARNING: Couldn't resolve default property of object CurrentFullTextCatalogColumnTableName. Click for more: 'ms-help://MS.VSCC.2003/commoner/redir/redirect.htm?keyword="vbup1037"'
2010: If CurrentFullTextCatalogColumnTableName = CurrentFullTextCatalogTableName Then
2011:
2012: 'Determine which table column this is
2013: 'UPGRADE_WARNING: Couldn't resolve default property of object CurrentFullTextCatalogColumnColumnName. Click for more: 'ms-help://MS.VSCC.2003/commoner/redir/redirect.htm?keyword="vbup1037"'
2014: 'UPGRADE_WARNING: Couldn't resolve default property of object CurrentFullTextCatalogTableID. Click for more: 'ms-help://MS.VSCC.2003/commoner/redir/redirect.htm?keyword="vbup1037"'
2015: SQL = "SELECT ColumnID FROM t_TableColumns WHERE fk_TableID = " & CurrentFullTextCatalogTableID & " AND ColumnName = '" & CurrentFullTextCatalogColumnColumnName & "'"
2016: 'UPGRADE_WARNING: Couldn't resolve default property of object CurrentFullTextCatalogColumnID. Click for more: 'ms-help://MS.VSCC.2003/commoner/redir/redirect.htm?keyword="vbup1037"'
2017: CurrentFullTextCatalogColumnID = DataStore.ExecuteSQLReturnSingleValue(SQL, "ColumnID")
2018:
2019: 'Store this column
2020: 'UPGRADE_WARNING: Couldn't resolve default property of object CurrentFullTextCatalogColumnID. Click for more: 'ms-help://MS.VSCC.2003/commoner/redir/redirect.htm?keyword="vbup1037"'
2021: If CurrentFullTextCatalogColumnID > 0 Then
2022: 'Store this full-text catalog table
2023: InsertSQL = "INSERT INTO "
2024: InsertSQL = InsertSQL & "t_FullTextCatalogsTableColumns "
2025: InsertSQL = InsertSQL & "( "
2026: InsertSQL = InsertSQL & "fk_TableID, "
2027: InsertSQL = InsertSQL & "fk_ColumnID"
2028: InsertSQL = InsertSQL & ") values ("
2029: 'UPGRADE_WARNING: Couldn't resolve default property of object CurrentFullTextCatalogTableID. Click for more: 'ms-help://MS.VSCC.2003/commoner/redir/redirect.htm?keyword="vbup1037"'
2030: InsertSQL = InsertSQL & CurrentFullTextCatalogTableID & ", "
2031: 'UPGRADE_WARNING: Couldn't resolve default property of object CurrentFullTextCatalogColumnID. Click for more: 'ms-help://MS.VSCC.2003/commoner/redir/redirect.htm?keyword="vbup1037"'
2032: InsertSQL = InsertSQL & CurrentFullTextCatalogColumnID & " "
2033: InsertSQL = InsertSQL & ")"
2034:
2035: 'UPGRADE_WARNING: Couldn't resolve default property of object SQLResult. Click for more: 'ms-help://MS.VSCC.2003/commoner/redir/redirect.htm?keyword="vbup1037"'
2036: SQLResult = DataStore.ExecuteSQL(InsertSQL)
2037:
2038: End If
2039:
2040: End If
2041:
2042: RS3.MoveNext()
2043:
2044: Loop
2045:
2046: End If
2047:
2048: RS2.MoveNext()
2049: Loop
2050:
2051: End If
2052:
2053: RS.MoveNext()
2054:
2055: Loop
2056:
2057: End If
2058: 'End of full-text catalogs
2059:
2060: End If 'End of HasDatabaseSQLError is false
2061:
2062: End If 'End of ensuring data connection is open
2063:
2064: ExtractData = True
2065:
2066: Call FormMain.DefInstance.UpdateCurrentItem("")
2067: Call AppendToLogFile(CurrentLogFileName, "**Data extraction completed for database '" & ConnectionDatabaseName & "'**" & vbCrLf & vbCrLf)
2068:
2069: End Function
2070: End Class