Ron Allen
chizotz at charter.net
Wed May 21 12:06:10 CDT 2003
Access97 and SQL Server2000. The idea is to access a table
in a SQL Server20000 database to populate a local table in
an Access97 front-end without using a stored passthrough
query or otherwise exposing the data or security
information to the user. The user will only have a
compiled .mde file, so this code would be inaccessible.
The below code works great on my development machine, but
when I try it on any of three of my user's machines I get
Library or Project not found. I can, however, create
stored passthrough queries on those machines, and all of
them have all options installed in Access97. My
development machine is WinXP Pro, user machines are
typically Win98. Any suggestions?
Thanks,
Ron
Public Sub TestTempPassthrough()
On Error GoTo ErrorHandle
Dim dbDW As Database
Dim dbJet As Database
Dim qdfDW As QueryDef
Dim rstDW As Recordset
Dim rstJet As Recordset
Dim strSQL As String
Dim strCurDate As String
DoCmd.SetWarnings False
strCurDate = Format(Date, "mm/dd/yyyy")
strSQL = "DELETE OutletList.* FROM OutletList;"
DoCmd.RunSQL (strSQL)
strSQL = "SELECT rte as Route, out_nbr as Outlet,
vnd_nbr as Vendor, "
strSQL = strSQL & "dist as District, dept_code as
Dept, area_code as Area, "
strSQL = strSQL & "zone_code as Zone, pd_owned as
PDOwned, pd_billed as PDBilled, "
strSQL = strSQL & "stld_delivered as STLDelivered,
contract as Contract, "
strSQL = strSQL & "abc_dlv_code1 as ABCDlvCode1,
abc_dlv_code2 as ABCDlvCode2, "
strSQL = strSQL & "abc_paid As ABCPaid, eff_date As
EffDate, end_date As EndDate "
strSQL = strSQL & "FROM circ.dbo.Distribution "
strSQL = strSQL & "WHERE (eff_date <= '" & strCurDate
& "' AND end_date > '" & strCurDate & "') "
strSQL = strSQL & "AND (rte <> '' and rte is not null
and rte <> '9999') "
strSQL = strSQL & "AND (out_nbr <> 0 and out_nbr is
not null) "
strSQL = strSQL & "AND (dept_code <> 'GC' and
dept_code <> 'TM')"
Set dbDW = DBEngine.Workspaces(0).Databases(0)
Set qdfDW = dbDW.CreateQueryDef("")
qdfDW.Connect =
"ODBC;DSN=db_pd1;UID=testuser;PWD=tu1234;DATABASE=CIRC"
qdfDW.SQL = strSQL
qdfDW.ReturnsRecords = True
qdfDW.ODBCTimeout = 0
Set rstDW = qdfDW.OpenRecordset()
Set dbJet = CurrentDb()
Set rstJet = dbJet.OpenRecordset("OutletList",
dbOpenTable)
With rstDW
.MoveFirst
Do
rstJet.AddNew
rstJet![AsOfDate] = Date
rstJet![Route] = CInt(![Route])
rstJet![Outlet] = ![Outlet]
rstJet![Vendor] = ![Vendor]
rstJet![District] = ![District]
rstJet![Dept] = ![Dept]
rstJet![Area] = ![Area]
rstJet![Zone] = ![Zone]
rstJet![PDOwned] = ![PDOwned]
rstJet![PDBilled] = ![PDBilled]
rstJet![STLDelivered] = ![STLDelivered]
rstJet![Contract] = ![Contract]
rstJet![ABCDlvCode1] = ![ABCDlvCode1]
rstJet![ABCDlvCode2] = ![ABCDlvCode2]
rstJet![ABCPaid] = ![ABCPaid]
rstJet.Update
.MoveNext
Loop Until .EOF
End With
ExitSub:
Set rstDW = Nothing
Set qdfDW = Nothing
Set dbDW = Nothing
Set rstJet = Nothing
Set dbJet = Nothing
DoCmd.SetWarnings True
Exit Sub
ErrorHandle:
MsgBox Err.Number & " " & Err.Description & " in
TestTempPassthrough"
Resume ExitSub
End Sub