-
Jan 24th, 2012, 04:01 PM
#1
Thread Starter
New Member
*** Help with Refreshing Data between VBA and SQL via ADO! ***
I'm not a developer but was left to figure out an old code by a programmer that left in 2007. I've updated the query with the correct select statement and server info; however, it still pulls data from the old server. This is in an Excel macro. I've spent the past week scouring the Net for help (including MS's site) while trying to locate the original programmer. Please help.
Thank you,
-Abe
Code:
Public Employee()
Public EmployeeType()
Public EmpList()
Public EmpType()
Sub Load_Employees(EmpCnt As Integer)
Dim inti As Integer
inti = 0
'Creating a dummy entry for adjusting the index (0) for unassigned employee
ReDim Preserve Employee(3, inti + 1)
ReDim Preserve EmpList(inti + 1)
Employee(0, inti) = "Unassigned"
Employee(1, inti) = "Not Applicable"
Employee(2, inti) = 0
EmpList(inti) = "Unassigned"
inti = inti + 1
Do While inti < EmpCnt
'Just Loading the Data in the Array
ReDim Preserve Employee(3, inti + 1)
ReDim Preserve EmpList(inti + 1)
Employee(0, inti) = Sheet2.Cells(inti + 2, "A")
Employee(1, inti) = Sheet2.Cells(inti + 2, "B")
Employee(2, inti) = Sheet2.Cells(inti + 2, "C")
EmpList(inti) = Sheet2.Cells(inti + 2, "A")
inti = inti + 1
Loop
'populating the Employee list Comboboxes from empList array
Sheet1.ComboBox1.List = EmpList
Sheet1.ComboBox2.List = EmpList
Sheet1.ComboBox3.List = EmpList
Sheet1.ComboBox4.List = EmpList
Sheet1.ComboBox5.List = EmpList
Sheet1.ComboBox6.List = EmpList
Sheet1.ComboBox7.List = EmpList
Sheet1.ComboBox8.List = EmpList
Sheet1.ComboBox9.List = EmpList
Sheet1.ComboBox10.List = EmpList
Sheet1.ComboBox11.List = EmpList
Sheet1.ComboBox12.List = EmpList
Sheet1.ComboBox13.List = EmpList
Sheet1.ComboBox14.List = EmpList
Sheet1.ComboBox15.List = EmpList
End Sub
Public Sub Load_EmployeeTypes(TypeCnt As Integer)
Dim inti As Integer
inti = 0
'Loading the first item as dummy to adjust the index for unassigned on combo boxes
ReDim Preserve EmployeeType(3, inti + 1)
ReDim Preserve EmpType(inti + 1)
EmployeeType(0, inti) = 0
EmployeeType(1, inti) = "Choose Staff Type"
EmployeeType(2, inti) = "Choose Staff Type"
EmpType(inti) = "Choose Staff Type"
inti = inti + 1
Do While (inti < TypeCnt)
'Just Loading the Data in the Array
ReDim Preserve EmployeeType(3, inti + 1)
ReDim Preserve EmpType(inti + 1)
EmployeeType(0, inti) = Sheet3.Cells(inti + 2, "A")
EmployeeType(1, inti) = Sheet3.Cells(inti + 2, "B")
EmployeeType(2, inti) = Sheet3.Cells(inti + 2, "C")
EmpType(inti) = Sheet3.Cells(inti + 2, "B")
inti = inti + 1
Loop
'populating the Employee type Combo box with EmpType array
Sheet1.ComboBox16.List = EmpType
Sheet1.ComboBox17.List = EmpType
Sheet1.ComboBox18.List = EmpType
Sheet1.ComboBox19.List = EmpType
Sheet1.ComboBox20.List = EmpType
Sheet1.ComboBox21.List = EmpType
Sheet1.ComboBox22.List = EmpType
Sheet1.ComboBox23.List = EmpType
Sheet1.ComboBox24.List = EmpType
Sheet1.ComboBox25.List = EmpType
Sheet1.ComboBox26.List = EmpType
Sheet1.ComboBox27.List = EmpType
Sheet1.ComboBox28.List = EmpType
Sheet1.ComboBox29.List = EmpType
Sheet1.ComboBox30.List = EmpType
End Sub
Public Function Get_EmplyeeType_Desc(BmsType_ID As Integer, CmbEmpType As ComboBox) As String
Dim inti As Integer
Dim RetVal As String
inti = 0
Do While (inti < UBound(EmployeeType, 2))
If (EmployeeType(0, inti) = BmsType_ID) Then
RetVal = EmployeeType(1, inti)
Exit Do
End If
inti = inti + 1
Loop
CmbEmpType.ListIndex = inti
Get_EmplyeeType_Desc = Trim(RetVal)
End Function
Public Function Get_EmplyeeType_Payrate(BmsType_ID As Integer) As Variant
Dim inti As Integer
Dim RetVal As Variant
inti = 0
Do While (inti < UBound(EmployeeType, 2))
If (EmployeeType(0, inti) = BmsType_ID) Then
RetVal = EmployeeType(2, inti)
Exit Do
End If
inti = inti + 1
Loop
Get_EmplyeeType_Payrate = RetVal
End Function
Public Sub Load_UserInfoForm()
Dim AllCorr As Boolean
AllCorr = Check_For_ProjectInfo()
'showing all the existing info if any so thta the user don;t have to key in all of them
strTitle = Sheet1.Range("H6").Text
strName = Sheet1.Range("R6").Text
strClient = Sheet1.Range("R7").Text
strDate = Sheet1.Range("R8").Text
UserForm1.TextBox1.Text = strTitle
UserForm1.TextBox2.Text = strName
UserForm1.TextBox3.Text = strClient
UserForm1.TextBox4.Text = strDate
If AllCorr = False Then
UserForm1.Show
End If
End Sub
Public Function Check_For_ProjectInfo()
Dim strTitle As String
Dim strName As String
Dim strClient As String
Dim strDate As String
strTitle = Sheet1.Range("H6").Text
strName = Sheet1.Range("R6").Text
strClient = Sheet1.Range("R7").Text
strDate = Sheet1.Range("R8").Text
If strTitle = "" Or strName = "" Or strClient = "" Or strDate = "" Then
Check_For_ProjectInfo = False
Else
Check_For_ProjectInfo = True
End If
End Function
Sub AddFooterToAll_FromEachSheet()
'Add A1 from each sheet to that sheet's header
Dim ws As Worksheet
For Each ws In ActiveWorkbook.Worksheets
ws.PageSetup.LeftFooter = ws.Range("R6").Value
Next ws
End Sub
Public Sub Update_EmployeeList_fromFMS()
'Create a connection object.
Dim cnPubs As ADODB.Connection
Set cnPubs = New ADODB.Connection
'Provide the connection string.
Dim strConn As String
strConn = "Provider=SQLOLEDB;Data Source=TempServer;Password=TempPW;User ID=TempID;Initial Catalog=TempDB;"
'Now open the connection.
cnPubs.Open strConn
'Create a recordset object.
Dim rsPubs As ADODB.Recordset
Set rsPubs = New ADODB.Recordset
'Giving dimensions to the Employee array from rsPubs
With rsPubs
'Assign the Connection object.
.ActiveConnection = cnPubs
'Extract the required records.
'.Open "Select Distinct a.CempName, b.csTypeDesc, a.BMSType_ID from bmemp a inner join bmstype b on a.BMSType_ID=b.BMSType_ID where a.DTermdate is Null and a.BMSType_ID<>2 order by a.CempName;"
.Open "select em.firstname+' '+EM.LastName, b.description, BillingCategory from EM inner join btlaborcatsdescriptions b on BillingCategory=b.Category where em.terminationdate is null order by em.firstname"
Dim indx As Integer
Dim TDate As String
TDate = Date
indx = 1
Sheet2.Range("A1", "A10") = "Employee List as of " + TDate
indx = 2
Sheet2.Range("A2") = "Employee Name"
Sheet2.Range("B2") = "Employee Type"
Sheet2.Range("C2") = "Employee Type ID"
Sheet2.Range("D2") = "Employee Count"
indx = 3
rsPubs.MoveFirst
Do While (Not rsPubs.EOF)
Sheet2.Cells(indx, "A") = rsPubs.Fields(0)
Sheet2.Cells(indx, "B") = rsPubs.Fields(1)
Sheet2.Cells(indx, "C") = rsPubs.Fields(2)
rsPubs.MoveNext
indx = indx + 1
Loop
End With
'Storing the count of employee
'Storing the Type Count
Sheet2.Cells(3, "D") = indx - 2 'take out 1st 2 rows and the last increament
'Tidy up
cnPubs.Close
Set rsPubs = Nothing
Set cnPubs = Nothing
End Sub
Public Sub Update_EmployeeTypesFromFMS()
'Create a connection object.
Dim cnPubs As ADODB.Connection
Set cnPubs = New ADODB.Connection
'Provide the connection string.
Dim strConn As String
strConn = "Provider=SQLOLEDB;Data Source=TempServer;Password=TempPW;User ID=TempID;Initial Catalog=TempDB;"
'Now open the connection.
cnPubs.Open strConn
'Create a recordset object.
Dim rsPubs As ADODB.Recordset
Set rsPubs = New ADODB.Recordset
'Giving dimensions to the Employee array from rsPubs
With rsPubs
' Assign the Connection object.
.ActiveConnection = cnPubs
' Extract the required records.
'.Open "Select distinct a.BMSType_ID, a.CSTYPEDESC, b.NHRBSRATE, c.CRSCHDesc from bmstype a inner join bmlratd b on a.BMSType_ID=b.BMSType_ID inner join bmrschm c on b.BMRSCHM_ID=c.BMRSCHM_ID where c.CRSCHDesc='2008 Rates 0% Markup'order by a.CSTYPEDESC;"
'.Open "Select distinct a.BMSType_ID, a.CSTYPEDESC, b.NHRBSRATE, c.CRSCHED from bmstype a inner join bmlratd b on a.BMSType_ID=b.BMSType_ID inner join bmrschm c on b.BMRSCHM_ID=c.BMRSCHM_ID where c.CRSCHED='2011A' order by a.CSTYPEDESC;"
.Open "select distinct BillingCategory, b.description, b.rate from EM inner join btrctcats b on BillingCategory=b.Category where b.tableno='2012' order by Description;"
'Populating the Title
Dim indx As Integer
Dim TDate As String
indx = 1
TDate = Date
Sheet3.Range("A1", "A10") = "Employee Type and Pay Rate as of " + TDate
indx = 2
Sheet3.Range("A2") = "Employee Type ID"
Sheet3.Range("B2") = "Employee Type"
Sheet3.Range("C2") = "Pay Rate"
Sheet3.Range("D2") = "Type Count"
indx = 3
rsPubs.MoveFirst
Do While (Not rsPubs.EOF)
Sheet3.Cells(indx, "A") = rsPubs.Fields(0)
Sheet3.Cells(indx, "B") = rsPubs.Fields(1)
Sheet3.Cells(indx, "C") = rsPubs.Fields(2)
rsPubs.MoveNext
indx = indx + 1
Loop
End With
'Storing the Type Count
Sheet3.Cells(3, "D") = indx - 2 'take out 1st 2 rows and the last increament
'Tidy up
cnPubs.Close
Set rsPubs = Nothing
Set cnPubs = Nothing
End Sub
Public Function FindRowIndxOfEmployee(EmpName As String) As Integer
Dim RowIndx As Integer
RowIndx = 0
Do While (RowIndx < UBound(Module1.EmpList))
If (Trim(EmpName) = Trim(Module1.EmpList(RowIndx))) Then
FindRowIndxOfEmployee = RowIndx
Exit Do
End If
RowIndx = RowIndx + 1
Loop
If (RowIndx = UBound(Module1.EmpList)) Then
FindRowIndxOfEmployee = -1
Else
FindRowIndxOfEmployee = RowIndx
End If
End Function
Public Function FindRowIndxOfEmployeeType(EmpTypeName As String) As Integer
Dim RowIndx As Integer
RowIndx = 0
Do While (RowIndx < UBound(Module1.EmpType))
If (Trim(EmpTypeName) = Trim(Module1.EmpType(RowIndx))) Then
FindRowIndxOfEmployeeType = RowIndx
Exit Do
End If
RowIndx = RowIndx + 1
Loop
If (RowIndx = UBound(Module1.EmpType)) Then
FindRowIndxOfEmployeeType = -1
Else
FindRowIndxOfEmployeeType = RowIndx
End If
End Function
Public Sub Process_ComboBoxChange(cmbx As ComboBox, cmbx2 As ComboBox, cmbCol As String, lstIndx As Integer)
Dim RowIndx As Integer
Dim BmsType_ID As Integer
Dim EmployeeTypeDesc As String
Dim EmployeeRate As Variant
RowIndx = lstIndx 'cmbx.ListIndex
If RowIndx = -1 Or RowIndx = 0 Then
Sheet1.Cells(9, cmbCol) = "Unassigned"
Exit Sub
End If
On Error Resume Next
Sheet1.Cells(9, cmbCol) = Trim(Employee(0, RowIndx))
BmsType_ID = Employee(2, RowIndx)
'Loading the BMSType Combo box with the selected BmsType selected
EmployeeTypeDesc = Get_EmplyeeType_Desc(BmsType_ID, cmbx2)
Sheet1.Cells(10, cmbCol) = Trim(EmployeeTypeDesc)
'Populating the Pay Rate field based on Emptype
EmployeeRate = Get_EmplyeeType_Payrate(BmsType_ID)
Sheet1.Cells(11, cmbCol) = Trim(EmployeeRate)
On Error GoTo 0
End Sub
Public Sub Process_KeyDown(KeyCode As Integer, cmbx As ComboBox, cmbx2 As ComboBox, cmbCol As String)
Dim RowIndx As Integer
If (KeyCode = 13) Then
RowIndx = FindRowIndxOfEmployee(Trim(cmbx.Text))
If (RowIndx = -1) Then
MsgBox ("The Employee name '" + Trim(cmbx.Text) + "' does not match any names in the current employee list." & vbNewLine & "Please check the spelling and try again")
Else
Process_ComboBoxChange cmbx, cmbx2, cmbCol, RowIndx
End If
End If
End Sub
Public Sub Process_EmpTypeComboBoxChange(cmbx As ComboBox, cmbCol As String, selIndx As Integer)
Dim RowIndx As Integer
Dim BmsType_ID As Integer
Dim EmployeTypeDesc As String
Dim NewPayRate As Variant
RowIndx = selIndx
If RowIndx = -1 Or RowIndx = 0 Then
Sheet1.Cells(10, cmbCol) = "Not Applicable"
Sheet1.Cells(11, cmbCol) = "Not Applicable"
Exit Sub
End If
On Error Resume Next
Sheet1.Cells(10, cmbCol) = Trim(EmployeeType(1, RowIndx))
'Getting the new employee type selected
BmsType_ID = Trim(EmployeeType(0, RowIndx))
'Get the corresponding pay rate
NewPayRate = Get_EmplyeeType_Payrate(BmsType_ID)
'Populating the PayRate cell with NewPayRate
Sheet1.Cells(11, cmbCol) = Trim(NewPayRate)
On Error GoTo 0
End Sub
Public Sub Process_EmpTypeKeyDown(KeyCode As Integer, cmbx As ComboBox, cmbCol As String)
Dim RowIndx As Integer
If (KeyCode = 13) Then
RowIndx = FindRowIndxOfEmployeeType(Trim(cmbx.Text))
If (RowIndx = -1) Then
MsgBox ("The Employee Type '" + Trim(cmbx.Text) + "' does not match any types in the current employee type list." & vbNewLine & "Please check the spelling and try again")
Else
Process_EmpTypeComboBoxChange cmbx, cmbCol, RowIndx
End If
End If
End Sub
[Code tags added by moderator]
-
Feb 11th, 2012, 06:56 PM
#2
Fanatic Member
Re: *** Help with Refreshing Data between VBA and SQL via ADO! ***
This is going to be nearly impossible to troubleshoot through the forums. All I can say is double check your table names and connection string.
-
Feb 15th, 2012, 02:24 PM
#3
Lively Member
Re: *** Help with Refreshing Data between VBA and SQL via ADO! ***
Look in your ODBC connections and see if there is one named "TempServer", probably need to update some values in there. Or look in the code/modules and see if there are any CONSTANT variables setup named TempServer and change server value there.
Posting Permissions
- You may not post new threads
- You may not post replies
- You may not post attachments
- You may not edit your posts
-
Forum Rules
|
Click Here to Expand Forum to Full Width
|