[AccessD] Grab Filenames

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


More information about the AccessD mailing list