ja******@oakland.edu (James Fortune) wrote in message news:<a6**************************@posting.google. com>...
I had a similar situation come up with an ecommerce app. The Access
adp had to download new orders from a SQL Server database. Once
Access had the new orders it deleted those orders on the server. As
an extra precaution, I had Access check itself for potential duplicate
OrderID's before adding the new ones.
James A. Fortune
{long)
I found the code I used. I didn't have time to pretty it up so don't
flame me if it doesn't all work. Also, I wrote some code that
automated putting the order information into HTML templates which were
then supposed to be emailed as attachments to confirm the orders.
What I did was sprinkle "[[FieldName]]" values at appropriate
locations in the HTML template and had Access read the template line
by line. It was complicated by the fact that information from both
tblOrders and tblOrderDetails had to be merged in so I had to
interrupt the tblOrders merge and append lines from an OrderDetails
template then go back to merging from the Orders template. If anyone
is interested I'll post the code I used. It's longer than the code
below so I'll try not to waste bandwidth unless someone requests that
I post it. The user could click a "magic button" on an Access form
and have all the new orders downloaded, deleted from the server, have
email confirmations sent (including having Access watch for folder
inactivity) to the purchaser, have the order information emailed to
the supplier and have a file created that can be easily imported into
QuickBooks. There were even more features, but you get the idea.
'------------
Private Sub cmdTransferInformation_Click()
'Need to use ADO to connect to SQL Server data
Dim connBackend As ADODB.Connection 'ADODB connection
Dim strConn As String
Dim cmdGo As ADODB.Command 'ADODB.Command
Dim prmName As ADODB.Parameter 'ADODB.Parameter
Dim FromRS As ADODB.Recordset 'ADO Recordset
Dim DeleteRS As ADODB.Recordset
Dim ToRS As Recordset 'Recordset
Dim strID As String
Dim strTemp As String
Dim lngI As Long
Dim lngJ As Long
Dim sCatID As String
Dim iMax As Integer
Dim sSKU As String
Dim iCmdStoredProc As Integer
Dim lngCountO As Long
Dim lngCountOD As Long
Dim OID() As Long
Dim ODID() As Long
Dim MyDB As Database
Dim theField As Field
Dim tdfTemp As TableDef
Dim lngFieldCount As Long
Dim dtImportDate As Date
Dim dtImportTime As Date
Dim strSQL As String
Dim lngOrderIDSSMax As Long
Dim lngOrderDetailIDSSMax As Long
Dim MaxRS As Recordset
Set MyDB = CurrentDb
Set connBackend = New ADODB.Connection
strConn = "Driver={SQL Server}; Network Library=DBMSSOCN; Data
Source=MySource; Uid=MyUid; Pwd=MyPassword;"
connBackend.Open strConn
'Eventually we'll want to use a stored procedure to return the results
'Set cmdGo = Server.CreateObject("ADODB.Command")
'Set cmdGo.ActiveConnection = connBackend
'cmdGo.CommandText = "SP_GetLevel0ID"
iCmdStoredProc = 4
'cmdGo.CommandType = iCmdStoredProc
'prmName.Value = "Chemical, Fluids and Lubricants"
'prmName.Value = cbxLevel0Pick.Text
'cmdGo.Parameters.Append prmName
lngCountO = 0
lngCountOD = 0
'------------------------------------------ tblOrders
Set tdfTemp = MyDB.TableDefs("tblOrders")
lngFieldCount = tdfTemp.Fields.Count
Set ToRS = MyDB.OpenRecordset("tblOrders", dbOpenDynaset)
'----Find where we left off
Set MaxRS = MyDB.OpenRecordset("SELECT MAX(OrderIDSS) AS MaxID FROM
tblOrders;", dbOpenSnapshot)
lngOrderIDSSMax = 0
If MaxRS.RecordCount > 0 Then
If Not IsNull(MaxRS("MaxID")) Then lngOrderIDSSMax = MaxRS("MaxID")
End If
MaxRS.Close
Set MaxRS = Nothing
'----
Set FromRS = New ADODB.Recordset
Set FromRS.ActiveConnection = connBackend
FromRS.CursorType = 1
FromRS.LockType = 3
'As each record is copied to the hard drive, put the SQL Server
'ID into an array so that the appropriate records can be
'deleted on the server
'Append. Be sure to fill importdate and importtime
lblStatus1.Caption = "tblOrders"
DoEvents
strTemp = "SELECT * FROM tblOrders WHERE OrderIDSS > " &
CStr(lngOrderIDSSMax) & ";"
FromRS.Open strTemp, connBackend, , , 1
If Not FromRS.EOF And Not FromRS.BOF Then
FromRS.MoveLast
lngCountO = FromRS.RecordCount
ReDim OID(lngCountO) As Long
FromRS.MoveFirst
dtImportDate = Format(Now(), "mm/dd/yy")
dtImportTime = Format(Now(), "hh:nn ampm")
For lngI = 1 To lngCountO
lblStatus2.Caption = CStr(lngI)
DoEvents
OID(lngI) = FromRS("OrderIDSS")
ToRS.AddNew
'I should use this tabledef technique more often
For lngJ = 0 To lngFieldCount - 1
ToRS(tdfTemp.Fields(lngJ).Name) =
FromRS(tdfTemp.Fields(lngJ).Name)
Next lngJ
ToRS("ImportDate") = dtImportDate
ToRS("ImportTime") = dtImportTime
ToRS.Update
If lngI <> lngCountO Then FromRS.MoveNext
Next lngI
lblStatus2.Caption = "Done."
DoEvents
End If
Set tdfTemp = Nothing
FromRS.Close
Set FromRS = Nothing
ToRS.Close
Set ToRS = Nothing
'------------------------------------------ tblOrderDetails
Set tdfTemp = MyDB.TableDefs("tblOrderDetails")
lngFieldCount = tdfTemp.Fields.Count
Set ToRS = MyDB.OpenRecordset("tblOrderDetails", dbOpenDynaset)
Set FromRS = New ADODB.Recordset
'----Find where we left off
Set MaxRS = MyDB.OpenRecordset("SELECT MAX(OrderDetailIDSS) AS MaxID
FROM tblOrderDetails;", dbOpenSnapshot)
lngOrderDetailIDSSMax = 0
If MaxRS.RecordCount > 0 Then
If Not IsNull(MaxRS("MaxID")) Then lngOrderDetailIDSSMax =
MaxRS("MaxID")
End If
MaxRS.Close
Set MaxRS = Nothing
'----
Set FromRS.ActiveConnection = connBackend
FromRS.CursorType = 1
FromRS.LockType = 3
'Append.
lblStatus1.Caption = "tblOrderDetails"
DoEvents
strTemp = "SELECT * FROM tblOrderDetails WHERE OrderDetailIDSS > " &
CStr(lngOrderDetailIDSSMax) & ";"
FromRS.Open strTemp, connBackend, , , 1
If Not FromRS.EOF And Not FromRS.BOF Then
FromRS.MoveLast
lngCountOD = FromRS.RecordCount
ReDim ODID(lngCountOD) As Long
FromRS.MoveFirst
For lngI = 1 To lngCountOD
lblStatus2.Caption = CStr(lngI)
DoEvents
ODID(lngI) = FromRS("OrderDetailIDSS")
ToRS.AddNew
For lngJ = 0 To lngFieldCount - 1
ToRS(tdfTemp.Fields(lngJ).Name) =
FromRS(tdfTemp.Fields(lngJ).Name)
Next lngJ
ToRS.Update
If lngI <> lngCountOD Then FromRS.MoveNext
Next lngI
lblStatus2.Caption = "Done."
DoEvents
End If
'Set cmdGo = Nothing
Set tdfTemp = Nothing
FromRS.Close
Set FromRS = Nothing
ToRS.Close
Set ToRS = Nothing
''-------------------------------------- Delete website orders
''Only delete orders that have been brought down
'lblStatus1.Caption = "Deleting website orders"
'DoEvents
''Now get the maximum IDSS that was brought down
'Set MaxRS = MyDB.OpenRecordset("SELECT MAX(OrderIDSS) AS MaxID FROM
tblOrders;", dbOpenSnapshot)
'lngOrderIDSSMax = 0
'If MaxRS.RecordCount > 0 Then
' If Not IsNull(MaxRS("MaxID")) Then lngOrderIDSSMax = MaxRS("MaxID")
'End If
'MaxRS.Close
'Set MaxRS = Nothing
''----
'strTemp = "DELETE tblOrders FROM tblOrders WHERE OrderIDSS <= " &
CStr(lngOrderIDSSMax) & ";"
'connBackend.Execute strTemp
'For lngI = 1 To 5000
' DoEvents
'Next lngI
''-------------------------------------- Delete website order details
'lblStatus1.Caption = "Deleting website details"
'DoEvents
''Now get the maximum IDSS that was brought down
'Set MaxRS = MyDB.OpenRecordset("SELECT MAX(OrderDetailIDSS) AS MaxID
FROM tblOrderDetails;", dbOpenSnapshot)
'lngOrderDetailIDSSMax = 0
'If MaxRS.RecordCount > 0 Then
' If Not IsNull(MaxRS("MaxID")) Then lngOrderDetailIDSSMax =
MaxRS("MaxID")
'End If
'MaxRS.Close
'Set MaxRS = Nothing
''----
'strTemp = "DELETE tblOrderDetails FROM tblOrderDetails WHERE
OrderDetailIDSS <= " & CStr(lngOrderDetailIDSSMax) & ";"
'connBackend.Execute strTemp
For lngI = 1 To 5000
DoEvents
Next lngI
lblStatus1.Caption = "Done."
DoEvents
'--------------------------------------
connBackend.Close
Set connBackend = Nothing
Set MyDB = Nothing
End Sub
James A. Fortune