*** Help with Refreshing Data between VBA and SQL via ADO! ***

:wave:

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]

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.

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.