I think this should work. When you click the Command0 button, all occurrences
of linefeeds that are not preceeded by a carriage return will be replaced
with carriage-return-linefeed characters. In other words, the little boxes
that you mention in your post will be replaced with line-breaks. Note,
however, that line-breaks are displayed by 2 little boxes.
Private Sub Command0_Click()
Dim Cnt%
Const SomeAlienText$ = "~`~`~`~"
Const C$ = vbCr, L$ = vbLf, CL$ = vbCrLf
Cnt = DCount("*", Tbl, "[Notes] Like '*[!" & C & "]" & L & "*'")
If Cnt > 0 then
MsgBox "About to replace " & Cnt & " linefeed occurrence(s) with
Carriage-Return+Linefeed"
Docmd.RunSQL "UPDATE [SomeTable] SET [SomeField] = " _
& "ReplaceSubString([SomeField], '" & vbCrLf & "', '" &
SomeAlienText & "', TRUE) " _
& "WHERE [SomeField] Like '*" & vbCrLf & "*'"
Docmd.RunSQL "UPDATE [SomeTable] SET [SomeField] = " _
& "ReplaceSubString([SomeField], '" & vbLf & "', '" & vbCrLf &
"', TRUE) " _
& "WHERE [SomeField] Like '*" & vbLf & "*'"
Docmd.RunSQL "UPDATE [SomeTable] SET [SomeField] = " _
& "ReplaceSubString([SomeField], '" & SomeAlienText & "', '" &
VbCrLf & "') " _
& "WHERE [SomeField] Like '*" & SomeAlienText & "*'"
Else
MsgBox "No new Linefeed occurrences were found"
Endif
EEnd Sub
Function ReplaceSubString$(ByVal MainString$, ByVal sFind$, ByVal sReplace$, _
Optional ByVal Recursive As Boolean = False)
'Searches MainText for, and replaces, FindText, with ReplaceText. Replaces
only 1st, or all instance(s) -
' based on Recursive. Replaces whole and partial words
Dim sBefore$, sAfter$
Dim iFindLen%, iFindIndex%
iFindLen = Len(sFind)
Do Until InStr(1, MainString, sFind, 1) = 0
iFindIndex = InStr(1, MainString, sFind, 1)
sBefore = Mid(MainString, 1, iFindIndex - 1)
sAfter = Mid(MainString, iFindIndex + iFindLen)
MainString = sBefore & sReplace & sAfter
If Not Recursive Then Exit Do
Loop
ReplaceSubString = MainString
End Function
Gersh76 said:
I guess I should be a little more clear about what I'm looking for. What I'm
doing is pasting from Excel to Access. The text in Excel has line spaces,
but when pasted into Access, the line spaces disappear and are replaced by a
little box. The code from my original post is used to replace these boxes
with line spaces. The code is used with a button on a form to go through all
the records one-by-one and fix the problem. I push the button once, it
reports back if it fixed it or not, then I push the button again and it
checks the next record, and so on. The database I'll be using it in has tens
of thousands of records, so I don't want to have to click through them all
everytime. I want to change this code or have someone write me a new one
that I can use to either fix only new records or specified records. It may
also work if it just ran through all the records with one click instead of
having to click every one. I did not write this code and really don't know
anything about it, so any help is greatly appreciated and please write back
as if you were writing to somebody that knows nothing about this code.
Thanks.
:
I want to change this code so that it will only check the records that I
specify, not every record in the table. Here is the code, can anyone help?
Private Sub Command0_Click()
On Error GoTo Err_Command0_Click
Dim tbl As Variant
Dim newnotes As String
Dim i As Integer
Set tbl = CurrentDb.OpenRecordset("Select * from Body")
If tbl.EOF Then
MsgBox "No Squares Found"
Exit Sub
Else
tbl.MoveFirst
i = 0
Do Until tbl.EOF
If Not IsNull(tbl.Notes) Then
newnotes = Replace(tbl.Notes, vbCrLf, "aabbccbbaa")
newnotes = Replace(newnotes, vbLf, vbCrLf)
newnotes = Replace(newnotes, "aabbccbbaa", vbCrLf)
i = i + 1
If tbl.Notes = newnotes Then
MsgBox "Record " & i & " not changed"
Else
MsgBox "RECORD " & i & " CHANGED"
End If
tbl.Edit
tbl.Notes = newnotes
tbl.Update
End If
tbl.MoveNext
Loop
End If
Exit_Command0_Click:
Exit Sub
Err_Command0_Click:
MsgBox Err.Description
Resume Exit_Command0_Click
End Sub
