Okay, here was my first attempt at this code to connect to a sybase server, get a recordset of tables, find what column number contains records I need, and then inserting values into a local table. It works. HOWEVER, 1)I have open 3 connections to the same database throughout, 2)It runs slow as christmas(20,000 records takes about 45 minutes to insert.one of my tables has 450,000 records). If anyone can help me with any of those problems, or just give me some good advice on how to clean this up to make it run in production better I would be forever grateful. In spite of looking like I know nothing about VBA, here is my code:
Option Compare Database
Sub get_audit_tables()
Dim sconntable As Variant
Dim proj_audit As ADODB.Connection
Dim cmdtables As New ADODB.Command
Dim sSQLtables As String
Dim rstables As ADODB.Recordset
Dim sSQLaudit As String
Dim cmdenddate As New ADODB.Command
Dim rsenddate As ADODB.Recordset
Dim denddate As Date
Dim strenddate As String
sconntable = "DSN=SYBSSPAY;Server Name=sybsspay,14000;User ID=MCOMBEST;Password=Kassidy05;"
Set proj_audit = New ADODB.Connection
With proj_audit
.ConnectionString = sconntable
.Open
End With
'get end date
strenddate = "Select end_date From RTIhr.dbo.u_payroll_report_parms,DBShrpn.dbo.payroll_run_type_pay_pd," & _
"DBSpclh.dbo.period Where RTIhr.dbo.u_payroll_report_parms.payroll_run_type_id = " & _
"DBShrpn.dbo.payroll_run_type_pay_pd.payroll_run_type_id and " & _
"RTIhr.dbo.u_payroll_report_parms.pay_pd_id = DBShrpn.dbo.payroll_run_type_pay_pd.pay_pd_id and " & _
"DBShrpn.dbo.payroll_run_type_pay_pd.periodic_cal_id = DBSpclh.dbo.period.periodic_cal_id and " & _
"DBShrpn.dbo.payroll_run_type_pay_pd.cal_yr = DBSpclh.dbo.period.cal_yr and " & _
"DBShrpn.dbo.payroll_run_type_pay_pd.period_type_code = DBSpclh.dbo.period.period_type_code and " & _
"DBShrpn.dbo.payroll_run_type_pay_pd.pd_nbr = DBSpclh.dbo.period.pd_nbr"
cmdenddate.ActiveConnection = proj_audit
cmdenddate.CommandText = strenddate
Set rsenddate = cmdenddate.Execute
denddate = rsenddate.Fields(0).Value
sSQLtables = "select sybase_table_name from DBShrpn.dbo.hr_audit_ctrl where audit_ind='Y' and " & _
"sybase_table_name not in('position','emp_status','emp_pay_element')"
cmdtables.ActiveConnection = proj_audit
cmdtables.CommandText = sSQLtables
'get sybase Audit tables
Set rstables = cmdtables.Execute
Do While Not rstables.EOF
stablename = RTrim(rstables.Fields(0).Value)
'get recordset from audit table
sSQLaudit = "select * from DBShrpn.dbo." & stablename & "_aud "
' where " & _
' "convert(datetime,(substring(ACTION_DATETIME,6,2)+'-'+substring(" & _
' "ACTION_DATETIME,9,2)+'-'+substring(ACTION_DATETIME,1,4)+' '+substring(ACTION_DATETIME,12,12))) BETWEEN " & _
' "DATEADD(day,-6,'" & denddate & "') AND DATEADD(day,1,'" & denddate & "')"
get_secondary_column (sSQLaudit)
rstables.MoveNext
Loop
End Sub
Private Sub get_secondary_column(sSQLcolumn As String)
Dim cmdcolumn As New ADODB.Command
Dim rscolumn As ADODB.Recordset
Dim icolumn As Integer
sconntable = "DSN=SYBSSPAY;Server Name=sybsspay,14000;User ID=MCOMBEST;Password=Kassidy05;"
Set proj_audit = New ADODB.Connection
With proj_audit
.ConnectionString = sconntable
.Open
End With
cmdcolumn.ActiveConnection = proj_audit
cmdcolumn.CommandText = sSQLcolumn
Set rscolumn = cmdcolumn.Execute
'Determine what column second emp_id resides in
For I = 0 To rscolumn.Fields.Count - 1
Select Case rscolumn.Fields(I).Name
Case "A_emp_id", "A_participant_id", "A_individual_id"
icolumn = I
Dim response
response = Insert_data(sSQLcolumn, icolumn)
Exit Sub
Case Else
End Select
Next
End Sub
Private Function Insert_data(sqlInsert As String, icolumn2 As Integer)
Dim cmdinsert As New ADODB.Command
Dim rsinsert As New ADODB.Recordset
Dim ilength As Integer
Dim iwhere As Integer
Dim n As Integer
sconntable = "DSN=SYBSSPAY;Server Name=sybsspay,14000;User ID=MCOMBEST;Password=Kassidy05;"
Set proj_audit = New ADODB.Connection
With proj_audit
.ConnectionString = sconntable
.Open
End With
cmdinsert.ActiveConnection = proj_audit
cmdinsert.CommandText = sqlInsert
Set rsinsert = cmdinsert.Execute
'ilength = Len(sqlInsert)
'iwhere = InStr(sqlInsert, "where")
stablename = Mid(sqlInsert, 15)
icolumn = icolumn2
If rsinsert.EOF = True Then
Exit Function
Else
n = 0
Do While Not rsinsert.EOF
n = n + 1
Select Case IsNull(rsinsert.Fields(icolumn).Value)
Case False
sqlcurrentdb = "INSERT INTO weekly_changes(ACTION_USER,ACTION_CODE,action_date,emp_id,change_table)" & _
"Values('" & rsinsert.Fields(1).Value & "','" & rsinsert.Fields(0).Value & "','" & _
Left(rsinsert.Fields(2).Value, 10) & "','" & rsinsert.Fields(icolumn).Value & "','" & _
stablename & "')"
CurrentDb.Execute sqlcurrentdb
rsinsert.MoveNext
Case Else
sqlcurrentdb = "INSERT INTO weekly_changes(ACTION_USER,ACTION_CODE,action_date,emp_id,change_table)" & _
"Values('" & rsinsert.Fields(1).Value & "','" & rsinsert.Fields(0).Value & "','" & _
Left(rsinsert.Fields(2).Value, 10) & "','" & rsinsert.Fields(3).Value & "','" & _
stablename & "')"
CurrentDb.Execute sqlcurrentdb
rsinsert.MoveNext
End Select
Loop
End If
End Function
Thanks again if anyone has help.
Option Compare Database
Sub get_audit_tables()
Dim sconntable As Variant
Dim proj_audit As ADODB.Connection
Dim cmdtables As New ADODB.Command
Dim sSQLtables As String
Dim rstables As ADODB.Recordset
Dim sSQLaudit As String
Dim cmdenddate As New ADODB.Command
Dim rsenddate As ADODB.Recordset
Dim denddate As Date
Dim strenddate As String
sconntable = "DSN=SYBSSPAY;Server Name=sybsspay,14000;User ID=MCOMBEST;Password=Kassidy05;"
Set proj_audit = New ADODB.Connection
With proj_audit
.ConnectionString = sconntable
.Open
End With
'get end date
strenddate = "Select end_date From RTIhr.dbo.u_payroll_report_parms,DBShrpn.dbo.payroll_run_type_pay_pd," & _
"DBSpclh.dbo.period Where RTIhr.dbo.u_payroll_report_parms.payroll_run_type_id = " & _
"DBShrpn.dbo.payroll_run_type_pay_pd.payroll_run_type_id and " & _
"RTIhr.dbo.u_payroll_report_parms.pay_pd_id = DBShrpn.dbo.payroll_run_type_pay_pd.pay_pd_id and " & _
"DBShrpn.dbo.payroll_run_type_pay_pd.periodic_cal_id = DBSpclh.dbo.period.periodic_cal_id and " & _
"DBShrpn.dbo.payroll_run_type_pay_pd.cal_yr = DBSpclh.dbo.period.cal_yr and " & _
"DBShrpn.dbo.payroll_run_type_pay_pd.period_type_code = DBSpclh.dbo.period.period_type_code and " & _
"DBShrpn.dbo.payroll_run_type_pay_pd.pd_nbr = DBSpclh.dbo.period.pd_nbr"
cmdenddate.ActiveConnection = proj_audit
cmdenddate.CommandText = strenddate
Set rsenddate = cmdenddate.Execute
denddate = rsenddate.Fields(0).Value
sSQLtables = "select sybase_table_name from DBShrpn.dbo.hr_audit_ctrl where audit_ind='Y' and " & _
"sybase_table_name not in('position','emp_status','emp_pay_element')"
cmdtables.ActiveConnection = proj_audit
cmdtables.CommandText = sSQLtables
'get sybase Audit tables
Set rstables = cmdtables.Execute
Do While Not rstables.EOF
stablename = RTrim(rstables.Fields(0).Value)
'get recordset from audit table
sSQLaudit = "select * from DBShrpn.dbo." & stablename & "_aud "
' where " & _
' "convert(datetime,(substring(ACTION_DATETIME,6,2)+'-'+substring(" & _
' "ACTION_DATETIME,9,2)+'-'+substring(ACTION_DATETIME,1,4)+' '+substring(ACTION_DATETIME,12,12))) BETWEEN " & _
' "DATEADD(day,-6,'" & denddate & "') AND DATEADD(day,1,'" & denddate & "')"
get_secondary_column (sSQLaudit)
rstables.MoveNext
Loop
End Sub
Private Sub get_secondary_column(sSQLcolumn As String)
Dim cmdcolumn As New ADODB.Command
Dim rscolumn As ADODB.Recordset
Dim icolumn As Integer
sconntable = "DSN=SYBSSPAY;Server Name=sybsspay,14000;User ID=MCOMBEST;Password=Kassidy05;"
Set proj_audit = New ADODB.Connection
With proj_audit
.ConnectionString = sconntable
.Open
End With
cmdcolumn.ActiveConnection = proj_audit
cmdcolumn.CommandText = sSQLcolumn
Set rscolumn = cmdcolumn.Execute
'Determine what column second emp_id resides in
For I = 0 To rscolumn.Fields.Count - 1
Select Case rscolumn.Fields(I).Name
Case "A_emp_id", "A_participant_id", "A_individual_id"
icolumn = I
Dim response
response = Insert_data(sSQLcolumn, icolumn)
Exit Sub
Case Else
End Select
Next
End Sub
Private Function Insert_data(sqlInsert As String, icolumn2 As Integer)
Dim cmdinsert As New ADODB.Command
Dim rsinsert As New ADODB.Recordset
Dim ilength As Integer
Dim iwhere As Integer
Dim n As Integer
sconntable = "DSN=SYBSSPAY;Server Name=sybsspay,14000;User ID=MCOMBEST;Password=Kassidy05;"
Set proj_audit = New ADODB.Connection
With proj_audit
.ConnectionString = sconntable
.Open
End With
cmdinsert.ActiveConnection = proj_audit
cmdinsert.CommandText = sqlInsert
Set rsinsert = cmdinsert.Execute
'ilength = Len(sqlInsert)
'iwhere = InStr(sqlInsert, "where")
stablename = Mid(sqlInsert, 15)
icolumn = icolumn2
If rsinsert.EOF = True Then
Exit Function
Else
n = 0
Do While Not rsinsert.EOF
n = n + 1
Select Case IsNull(rsinsert.Fields(icolumn).Value)
Case False
sqlcurrentdb = "INSERT INTO weekly_changes(ACTION_USER,ACTION_CODE,action_date,emp_id,change_table)" & _
"Values('" & rsinsert.Fields(1).Value & "','" & rsinsert.Fields(0).Value & "','" & _
Left(rsinsert.Fields(2).Value, 10) & "','" & rsinsert.Fields(icolumn).Value & "','" & _
stablename & "')"
CurrentDb.Execute sqlcurrentdb
rsinsert.MoveNext
Case Else
sqlcurrentdb = "INSERT INTO weekly_changes(ACTION_USER,ACTION_CODE,action_date,emp_id,change_table)" & _
"Values('" & rsinsert.Fields(1).Value & "','" & rsinsert.Fields(0).Value & "','" & _
Left(rsinsert.Fields(2).Value, 10) & "','" & rsinsert.Fields(3).Value & "','" & _
stablename & "')"
CurrentDb.Execute sqlcurrentdb
rsinsert.MoveNext
End Select
Loop
End If
End Function
Thanks again if anyone has help.