T
Trevor
Despite all the help that has been given me, I am still
having problems with quotes/appostrophes in strings.
These are some the addressIDs that I am having a problem
with
Address_ID Surname Forename
""'D DEEPROSE Rebecca (Two Quotes, an
appostrophe and D)
""'( DAVIS Antony (Two Quotes, an
appostrophe and ()
""'C RIPLEY Jack (Two Quotes, an
appostrophe and C)
""'" DAVIES Matthew (Two Quotes, an
appostrophe and another Quote)
The ones that were giving me problems, but no longer are
(FixQuotes fixed this)
were IDs such as:
""C' (Quote, quote, C, appostrophe)
""^' (Quote, quote, hat, appostrophe)
Note that the appostrophe is the last character.
All IDs start with two quotqtion marks and contain two
other characters.
I cannot use a query to join the IDs because there are IDs
such as ""Cx and ""cx which
represent different addresses (Current and previous
address) in the original database,
but a query will return both addresses for the student. I
have actually used a query
to 'get rid' of definately unwanted addresses to compile
the table tblLocalAddresses.
The case problem is resolved after the find, by using
strComp, and findNext if case
does not match.
But still have the problem of the quotes.
I have noticed the possible 'doom loop' if
FixQuotes returns a duff string although
with the strings that I have it doesn't happen.
My code is listed below, without the actual copy code.
TIA again
Trevor
Sub GetAddressFromSIMS(strListToUse As String)
'Looks down StudentList, gets addressID, looks up
addressID in tblLocalAddresses _
if found pastes address data into StudentList
Dim db As Database
Dim rstStudentList As Recordset
Dim rstAddress As Recordset
Dim strCriteria As String
Dim NoAddress As Long
Dim StringMismatch As Long
Dim AddressesAdded As Long
Dim lngMaxRecords As Long
Dim lngRecordCount As Long
Dim fTryAgain As Boolean
Dim TimeNow
On Error GoTo Err_In_Sub
Set db = DBEngine.Workspaces(0).Databases(0)
Set rstAddress = db.OpenRecordset("tblLocalAddresses",
dbOpenDynaset) '(SIMS)
'strListToUse contains a valid tablename
Set rstStudentList = db.OpenRecordset(strListToUse,
dbOpenDynaset) '(SIMS)
DoCmd.Hourglass True
Do Until rstStudentList.EOF
DoEvents
lngRecordCount = lngRecordCount + 1
Forms!frmsearch!ProgBar = lngRecordCount
DoEvents
strCriteria = "[address_ID]='" & rstStudentList!
ADdress_ID & "'"
TryAgain:
'Findfirst generates a 3077 error if strcriteria is
duff. This is trapped and the string is passed to
FixQuotes and the search tried again
rstAddress.FindFirst strCriteria
If rstAddress.NoMatch Then
'No matching address
NoAddress = NoAddress + 1
If fTryAgain Then
MsgBox "Cannot find an address for this
student." & strCriteria
End If
fTryAgain = False
Else
'An address_ID has been found in the Address table
'strComp is used after the find because the
students address_ID _
is case sensitive in SIMS _
and the same ID is used with different case for a
change of address _
The Access search engine is not case sensitive so
a binary strComp _
has to be dome on all found address_IDs for a
student _
to make the search appear case sensitive
Do Until rstAddress.NoMatch
If StrComp(rstAddress!ADdress_ID,
rstStudentList!ADdress_ID, 0) = 0 Then
'Case check of found address_ID is ok so
copy data
rstStudentList.Edit
'Copy code in here
Exit Do
End If
'Case check is not ok, so find the next
address_ID
rstAddress.FindNext strCriteria
Loop
End If
rstStudentList.MoveNext
Loop
exit_Sub:
DoCmd.Hourglass False
rstStudentList.Close
rstAddress.Close
Set rstStudentList = Nothing
Set rstAddress = Nothing
Set db = Nothing
Exit Sub
Err_In_Sub:
Select Case Err.Number
Case 3077 'This is generated every once in a while
because of the format _
of the SIMS address_ID, which contains quotation
marks and _
appostrophies which the Access search engine does
not like too much. _
As there are only a few of these, the error is
ignored, apart from _
counting the duffIDs, and the next student's
address_ID is checked
strCriteria = "Address_ID = '" & FixQuotes
(rstStudentList!ADdress_ID) & "'"
fTryAgain = True
Resume TryAgain
Case Else
MsgBox Err.Number & " " & Err.Description & " in
routine 'GetAddressFromSIMS'", vbCritical, "Error in Sub"
End Select
Resume exit_Sub
End Sub
Function FixQuotes(strToFix As String) As String
Dim strtemp As String
Dim I As Integer
For I = 1 To Len(strToFix)
If Mid(strToFix, I, 1) = Chr$(39) Then
strtemp = strtemp & Chr$(39)
End If
strtemp = strtemp & Mid(strToFix, I, 1)
Next
FixQuotes = strtemp
End Function
having problems with quotes/appostrophes in strings.
These are some the addressIDs that I am having a problem
with
Address_ID Surname Forename
""'D DEEPROSE Rebecca (Two Quotes, an
appostrophe and D)
""'( DAVIS Antony (Two Quotes, an
appostrophe and ()
""'C RIPLEY Jack (Two Quotes, an
appostrophe and C)
""'" DAVIES Matthew (Two Quotes, an
appostrophe and another Quote)
The ones that were giving me problems, but no longer are
(FixQuotes fixed this)
were IDs such as:
""C' (Quote, quote, C, appostrophe)
""^' (Quote, quote, hat, appostrophe)
Note that the appostrophe is the last character.
All IDs start with two quotqtion marks and contain two
other characters.
I cannot use a query to join the IDs because there are IDs
such as ""Cx and ""cx which
represent different addresses (Current and previous
address) in the original database,
but a query will return both addresses for the student. I
have actually used a query
to 'get rid' of definately unwanted addresses to compile
the table tblLocalAddresses.
The case problem is resolved after the find, by using
strComp, and findNext if case
does not match.
But still have the problem of the quotes.
I have noticed the possible 'doom loop' if
FixQuotes returns a duff string although
with the strings that I have it doesn't happen.
My code is listed below, without the actual copy code.
TIA again
Trevor
Sub GetAddressFromSIMS(strListToUse As String)
'Looks down StudentList, gets addressID, looks up
addressID in tblLocalAddresses _
if found pastes address data into StudentList
Dim db As Database
Dim rstStudentList As Recordset
Dim rstAddress As Recordset
Dim strCriteria As String
Dim NoAddress As Long
Dim StringMismatch As Long
Dim AddressesAdded As Long
Dim lngMaxRecords As Long
Dim lngRecordCount As Long
Dim fTryAgain As Boolean
Dim TimeNow
On Error GoTo Err_In_Sub
Set db = DBEngine.Workspaces(0).Databases(0)
Set rstAddress = db.OpenRecordset("tblLocalAddresses",
dbOpenDynaset) '(SIMS)
'strListToUse contains a valid tablename
Set rstStudentList = db.OpenRecordset(strListToUse,
dbOpenDynaset) '(SIMS)
DoCmd.Hourglass True
Do Until rstStudentList.EOF
DoEvents
lngRecordCount = lngRecordCount + 1
Forms!frmsearch!ProgBar = lngRecordCount
DoEvents
strCriteria = "[address_ID]='" & rstStudentList!
ADdress_ID & "'"
TryAgain:
'Findfirst generates a 3077 error if strcriteria is
duff. This is trapped and the string is passed to
FixQuotes and the search tried again
rstAddress.FindFirst strCriteria
If rstAddress.NoMatch Then
'No matching address
NoAddress = NoAddress + 1
If fTryAgain Then
MsgBox "Cannot find an address for this
student." & strCriteria
End If
fTryAgain = False
Else
'An address_ID has been found in the Address table
'strComp is used after the find because the
students address_ID _
is case sensitive in SIMS _
and the same ID is used with different case for a
change of address _
The Access search engine is not case sensitive so
a binary strComp _
has to be dome on all found address_IDs for a
student _
to make the search appear case sensitive
Do Until rstAddress.NoMatch
If StrComp(rstAddress!ADdress_ID,
rstStudentList!ADdress_ID, 0) = 0 Then
'Case check of found address_ID is ok so
copy data
rstStudentList.Edit
'Copy code in here
Exit Do
End If
'Case check is not ok, so find the next
address_ID
rstAddress.FindNext strCriteria
Loop
End If
rstStudentList.MoveNext
Loop
exit_Sub:
DoCmd.Hourglass False
rstStudentList.Close
rstAddress.Close
Set rstStudentList = Nothing
Set rstAddress = Nothing
Set db = Nothing
Exit Sub
Err_In_Sub:
Select Case Err.Number
Case 3077 'This is generated every once in a while
because of the format _
of the SIMS address_ID, which contains quotation
marks and _
appostrophies which the Access search engine does
not like too much. _
As there are only a few of these, the error is
ignored, apart from _
counting the duffIDs, and the next student's
address_ID is checked
strCriteria = "Address_ID = '" & FixQuotes
(rstStudentList!ADdress_ID) & "'"
fTryAgain = True
Resume TryAgain
Case Else
MsgBox Err.Number & " " & Err.Description & " in
routine 'GetAddressFromSIMS'", vbCritical, "Error in Sub"
End Select
Resume exit_Sub
End Sub
Function FixQuotes(strToFix As String) As String
Dim strtemp As String
Dim I As Integer
For I = 1 To Len(strToFix)
If Mid(strToFix, I, 1) = Chr$(39) Then
strtemp = strtemp & Chr$(39)
End If
strtemp = strtemp & Mid(strToFix, I, 1)
Next
FixQuotes = strtemp
End Function