With the help of my previous company's IT dept, I was able to set up a procedure to query and pull data into excel for financial planning. This was done in ms 2003. I have tried to copy that procedure and use in ms 2007, but it doesn't work. When I import data using excel's "Get external data -> access", the data come over in a structured table. I want the information to be pull into a formated table that will be as a linked table in a powerpoint slide. Below is the code using. When I try to run I get a "User-defined type not defined on function (OpenTable)
Code:Global gstrCNN As String Global gstrDB As String ' Access Database Global gwb As Workbook Global gbLocalDB As Boolean Global Vbl As Worksheet Function initGlobals() ' Set global variables SetVbl gstrworkingDirectory = Vbl.Range("DBPath") gstrDB = gstrworkingDirectory & "\" & Vbl.Range("DBName") 'gstrCNN = "Provider=Microsoft.Jet.OLEDB.4.0;User ID=Admin;Data Source=" & gstrDB & ";" gstrCNN = "Provider=Microsoft.ACE.OLEDB.12.0;Password="""";User ID=Admin;Data Source=" & gstrDB & ";" gstrCNN = gstrCNN & "Mode=Share Deny Write;Extended Properties="""";Jet OLEDB:System database="""";" gstrCNN = gstrCNN & "Jet OLEDB:Registry Path="""";Jet OLEDB:Engine Type=6;" gstrCNN = gstrCNN & "Jet OLEDB:Database Locking Mode=0;Jet OLEDB:Global Partial Bulk Ops=2;" gstrCNN = gstrCNN & "Jet OLEDB:Global Bulk Transactions=1;Jet OLEDB:New Database Password="""";" gstrCNN = gstrCNN & "Jet OLEDB:Create System Database=False;Jet OLEDB:Encrypt Database=False;" gstrCNN = gstrCNN & "Jet OLEDB:Don't Copy Locale on Compact=False;Jet OLEDB:Compact Without Replica Repair=False;" gstrCNN = gstrCNN & "Jet OLEDB:SFP=False;Jet OLEDB:Support Complex Data=False;" 'gstrCNN = "Provider=Microsoft.ACE.OLEDB.12.0;User ID=Admin;Data Source=" & gstrDB & ";" 'gstrCNN = gstrCNN & "Jet OLEDB:Database Password=jc" End Function Function OpenTable(strsql As String) As Recordset initGlobals Dim conn As New Connection ' Creating a new Access Data Base connection Dim rs As New Recordset ' Creating a connection to new Access Data table conn.Open (gstrCNN) rs.Open strsql, conn ', adOpenDynamic, adLockPessimistic Set OpenTable = rs Dim i, j i = 1 j = 1 End Function Function fillDumpCell(rs As Recordset, Sht, lngColNumber, lngRowNumber, lngFieldRow) Dim strFieldName As String Dim strTemp As String Dim lngXPeriod As Long Dim lngCurPeriod As Long strFieldName = Sht.Cells(lngFieldRow, lngColNumber) Sht.Cells(lngRowNumber, lngColNumber) = rs(strFieldName) 'MsgBox Mid(strFieldName, 2) End Function Public Sub SetVbl() Vbl = Sheets("Vbl") End Sub Sub RetrieveData() On Error GoTo BadRetrieve 'starttime = Now 'ClearDump initGlobals On Error GoTo 0 Dim rsDump As Recordset Dim shtDump As Worksheet Dim strsql As String Dim i As Long Dim j As Long Dim lngStartRow As Long Dim lngFieldRow As Long lngStartRow = 2 'first data row lngFieldRow = 1 ' header row lngEndColumn = 15 '# of columns retrieved Set shtDump = Sheets("dump") j = 1 'First Column i = lngStartRow Application.Calculation = xlCalculationManual strsql = "SELECT t_Players.[Player #], t_Players.Player, t_Players.Email, t_Players.Pool1, t_Players.Pool2 " strsql = strsql & "FROM t_Players " strsql = strsql & "WHERE t_Players.Player Like ""b*"";" Set rsDump = OpenTable(strsql) 'InputBox strsql, strsql, strsql While Not rsDump.EOF While j <= lngEndColumn fillDumpCell rsDump, shtDump, j, i, lngFieldRow j = j + 1 Wend j = 1 rsDump.MoveNext i = i + 1 Wend rsDump.Close ' endtime = Now 'MsgBox (i & " records retrieved" & starttime & " " & endtime) Application.Calculation = xlCalculationAutomatic Exit Sub BadRetrieve: Msg = "You are unable to retrieve data at this time. " Msg = Msg & "Verify that you have access to the Plan directory " Msg = Msg & "and try again. If you continue to have problems pray or call " Msg = Msg & "John Caulfied. " MsgBox Msg End Sub