Max Wanadoo
max.wanadoo at gmail.com
Wed Feb 18 11:55:52 CST 2009
Hi Rocky, Hope these two examples help. Ignore the rubbish coding... You can also position directly onto the rst as shown in vers 2. Max Public Property Get AddNewLocationFromForm(frm As Form) As Long ' Adds a new location based on the data entered into the form On Error GoTo errhandler Dim lngLocationID As Long, lngMailsortAID As Long sqlGeoMailsortA = "SELECT * From mcmGeoMailsortA Where MailsortAID=" & frm!FKMailsortAIDx Set rstGeoMailsortA = dbs.OpenRecordset(sqlGeoMailsortA) If rstGeoMailsortA.EOF Then MsgBox "I cannot find this PostalCode" GoTo exithere Else lngMailsortAID = rstGeoMailsortA!MailsortAID End If sqlLocation = "SELECT * From mcmGeoLocations Where " & _ "FKCountryID = " & Nz(frm!FKCountryIDx, 617) & _ " AND OverseasPostCode = " & conQuote & Nz(frm!OverseasPostCodex, "") & conQuote Set rstLocation = dbs.OpenRecordset(sqlLocation) If rstLocation.EOF Then lngLocationID = 0 rstLocation.AddNew rstLocation!FKCountryID = Nz(frm!FKCountryIDx, 617) rstLocation!OverseasPostCode = Nz(frm!OverseasPostCodex, "") rstLocation!LastUser = "System" rstLocation!LastEdited = Date rstLocation!CreatedBy = "System" rstLocation!CreateDate = Date rstLocation.Update rstLocation.Move 0, rstLocation.LastModified lngLocationID = rstLocation!LocationID Else lngLocationID = rstLocation!LocationID End If exithere: If lngLocationID = 0 Then MsgBox "This Location cannot be added" Else MsgBox "Location has been added/already present (" & lngLocationID & ")" End If AddNewLocationFromForm = lngLocationID Exit Property errhandler: Select Case Err.Number Case 3022 'dupes lngLocationID = 0 GoTo exithere Case Else MsgBox "Error in Property Get AddNewLocationFromForm: " & Err.Number & vbCrLf & Err.Description Resume exithere End Select End Property Private Function CreateLineRecords(strFile As String, frm As Form) On Error GoTo errhandler If gbMcmModuleLogging = True Then Call mcmModuleLogging("MCM_DoctorsAndOpthalmic", "CreateLineRecords", True) Dim dbs As DAO.Database, rst As DAO.Recordset, sql As String Set dbs = CurrentDb sql = "delete * from Lines" Call pfRunSql(sql) sql = "Select * from Lines" Set rst = dbs.OpenRecordset(sql) Dim strTemp As String, iPos2 As Integer Dim i As Integer, iASC As Integer, iPos As Integer, strOut As String, strIn As String Dim strFullIn As String, strFullOut As String Dim bContinuation As Boolean bContinuation = True ReadingCount = 0 frm!ReadingFile = "Reading " & strFile frm!ReadingCount = ReadingCount WritingCount = 0 frm!ReadingFile = "Writing Line Records " & strFile frm!WritingCount = WritingCount frm.Repaint Open strFile For Input As #3 Do While Not EOF(3) Input #3, strTemp If Len(Trim(strTemp)) > 0 Then ' see if this is a continuation or new line bContinuation = False For i = 1 To 24 bContinuation = True If InStr(strTemp, ary(i)) > 0 Then bContinuation = False Exit For End If Next i If bContinuation Then rst.Edit 'rst!Line = rst!Line & vbCrLf & str rst!Line = rst!Line & ", " & Trim(strTemp) rst.Update Else rst.AddNew rst!Line = strTemp rst.Update rst.Bookmark = rst.LastModified WritingCount = WritingCount + 1 End If End If ReadingCount = ReadingCount + 1 frm!ReadingCount = ReadingCount frm!WritingCount = WritingCount frm.Repaint Loop exithere: If gbMcmModuleLogging = True Then Call mcmModuleLogging("MCM_DoctorsAndOpthalmic", "CreateLineRecords", False) Close 3 Set rst = Nothing Exit Function errhandler: MsgBox "Error: " & Err.Number & vbCrLf & Err.Description GoTo exithere End Function