We have a site which has a number of useful functions written by our third-party programmer, but lately, I've noticed that one of them seems to be putting a space in when it runs, but I can't seem to find where that might be in order to remove it.
The function is called "formatspecialcharacters". It's function is to take a string and look through it to change special characters from the string into HTML entities and is written as:
function formatspecialcharacters(stringtoformat)
formatspecialcharacters = ""
if isblank(stringtoformat) then exit function
stringtoformat = CStr(stringtoformat)
stringtoformat = Trim(stringtoformat)
fieldcontents = HTMLDecode(stringtoformat)
if Len(fieldcontents)>0 then
for character_i = 1 to Len(fieldcontents)
character_c = asc(mid(fieldcontents, character_i, 1))
select case character_c
case 174, 169
formatspecialcharacters = formatspecialcharacters & "<sup>" & chr(character_c) & "</sup>"
case else
formatspecialcharacters = formatspecialcharacters & chr(character_c)
end select
next
end if
end function
The other function running inside the one above (HTMLDecode) is written as:
Function HTMLDecode(sText)
sText = vbcrlf & vbtab & sText
Dim I
sText = Replace(sText, """, Chr(34))
sText = Replace(sText, "<" , Chr(60))
sText = Replace(sText, ">" , Chr(62))
sText = Replace(sText, Chr(62) , Chr(62) & vbcrlf & vbtab)
sText = Replace(sText, "&" , Chr(38))
sText = Replace(sText, " ", Chr(32))
sText = Replace(sText, Chr(147), Chr(34)) 'smart quotes to proper quotes
sText = Replace(sText, Chr(148), Chr(34))
sText = Replace(sText, Chr(146), Chr(39)) 'smart apostrophe to proper apostrophe
For I = 1 to 255
sText = Replace(sText, "&#" & I & ";", Chr(I))
Next
HTMLDecode = sText
End Function
I think it's probably in the second function because when I use it like this:
<%=formatspecialcharacters(decendentdocumentformat_label(j))%>
Where "decendentdocumentformat_filename(j)" = "/example.html" and "formatspecialcharacters(decendentdocumentformat_label(j))" = "Web Page"
In this example, when it's rendered, I have the link, followed by a space and then the label (in this case, "Web Page") when it should just be the link then the label with no space between them.
Any help would be great.
Thanks in advance.
Not 100% sure I follow but if you were to;
<p><%=formatspecialcharacters("AAA") %><%=formatspecialcharacters("BBB") %></p>
You would see a space; AAA BBB because the 1st thing HTMLDecode does is prepend a carriage-return/line feed & tab to the input string, which the browser displays as a whitespace.
If you dont want the visible space remove sText = vbcrlf & vbtab & sText
(Also, the input is not trimmed after HTMLDecode, so if it were passed "XXX " you would have a trailing space)
Related
My requirement is to remove the special characters especially double quotes from the adodb recordset while exporting to CSV in VB6 using the below code.
if any double quotes is present the value after double quotes is moved to next column.
Specifically, the double quotes are present in rsData.Fields(K).Value not in rsData.Fields(K).Name. I'm not sure how to remove the double quotes in rsData.Fields(K).Value.
Any help to fix this issue will be greatly appreciated. Thanks in advance.
'Converting the recordset
Public Function RecordsetToCSV(rsData As ADODB.Recordset, Optional ShowColumnNames As Boolean = True, Optional NULLStr As String = "") As String
Dim K As Long, RetStr As String
If ShowColumnNames Then
For K = 0 To rsData.Fields.Count - 1
RetStr = RetStr & ",""" & rsData.Fields(K).Name & """"
Next K
RetStr = Mid(RetStr, 2) & vbNewLine
End If
RetStr = RetStr & """" & rsData.GetString(adClipString, -1, """,""", """" & vbNewLine & """", NULLStr)
RetStr = Left(RetStr, Len(RetStr) - 3)
RecordsetToCSV = RetStr
End Function
'Creating CSV file
Dim CSVData As String
CSVData = RecordsetToCSV(rsData, True)
Open "C:\test.csv" For Binary Access Write As #1
Put #1, , CSVData
Close #1
reference : https://www.vbforums.com/showthread.php?481705-VB6-Save-Recordset-to-CSV-format
You need to escape the double quotes, which is done by doubling them up.
RetStr = RetStr & ",""" & Replace(rsData.Fields(K).Name, """", """""") & """"
You could just use the defaults to import the data with double quotes by using the character as the delimiter
Change:
RetStr = RetStr & ",""" & rsData.Fields(K).Name & """"
To:
RetStr = RetStr & "," & vbTab & rsData.Fields(K).Name & vbTab
And
RetStr = RetStr & """" & rsData.GetString(adClipString, -1, """,""", """" & vbNewLine & """", NULLStr)
To:
RetStr = RetStr & rsData.GetString(adClipString)
And you might have to change the last line that removes those last characters to
RetStr = Left(RetStr, Len(RetStr) - 2)
EDIT - If you really truly feel the double quotes must be removed from your data, you can do it by using a different delimiter initially - say the squiggle "~" and then replace double quotes in one step, and the squiggle in next step
As in:
RetStr = RetStr & "~" & rsData.GetString(adClipString, -1, "~")
Last lines would then be
RetStr = Replace(RetStr,"""","")
RecordsetToCSV = Replace(RetStr,"~","""")
And of course remember to use the "~" in your column header loop
RetStr = RetStr & ",~" & rsData.Fields(K).Name & "~"
I've been working on a spread sheet to allow my team to manage our workload more effectively, whilst the business is developing a new tool. Anyway, what the sheet does is inject information, then at the click of a button, it populates an OFT email template so that the info can be sent out.
Problem is, we rely heavily on bullet lists for our emails, and I'm really struggling to find a way of adding bullets effectively from an ActiveX Textbox.
At the moment, I have a button which adds the follow to a text box:
[bullets]
* Bullet 1
* Bullet 2
* Bullet 3
[/bullets]
I then have Replace statements that look for strings and it replaces them with the appropriate HTML tags. Here's the code:
' Add HTML formatting to text updates so it displays correctly in the email.
LatestUpdate.Text = Replace(LatestUpdate, "[bullets]", "<ul>")
LatestUpdate.Text = Replace(LatestUpdate, "[/bullets]", "</ul>")
LatestUpdate.Text = Replace(LatestUpdate, "* ", "<li>")
LatestUpdate.Text = Replace(LatestUpdate, vbCrLf, "<br>")
The problem I'm having, is that non-technical people are using this document, so I would really like to have it in such a way were they don't have to look at the markup, but can simple add bullets straight from the textbox.
I was originally thinking about replacing "* " with "< li >" however, that doesn't add the correct < ul > tags, so it's not actually a bullet list within the email.
Can anyone help in simplifying this process for the end users please? I'm really stuck.
The holy grail would be to enable rich text formatting on the textbox, but I don't believe that's possible from all the research I've done?
TIA.
Based on your last comment, what you are looking for is not just a bullet point in your textbox but indentation as well. So here is an attempt at it:
First add the below in your <textbox>_KeyUp function:
Private Sub txtBulletPoints_KeyUp(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer)
Dim STRING_LENGTH As Long: STRING_LENGTH = 49
Dim aLine() As String
Dim aLineSpace() As String
Dim iC As Integer
Dim sText As String
Dim bUpdate As Boolean
' Only do this if there is a string to work with
If Len(Me.txtBulletPoints.Text) > 0 Then
' Set initial values
aLine = Split(Me.txtBulletPoints.Text, vbCrLf)
bUpdate = False
' First lets indent the last line if we need to
If Left(aLine(UBound(aLine)), 2) = "- " Then
For iC = LBound(aLine) To UBound(aLine)
If iC = UBound(aLine) Then
sText = sText & vbTab & aLine(iC)
Else
sText = sText & aLine(iC) & vbCrLf
End If
Next
Me.txtBulletPoints.Text = sText
End If
' Now the tricky bit. Check if we have reached the end of the
' line so that we can indent the text into the next line
If (Len(aLine(UBound(aLine))) >= STRING_LENGTH) And (InStr(1, aLine(UBound(aLine)), vbTab) = 1) Then
For iC = LBound(aLine) To UBound(aLine)
If iC = UBound(aLine) Then
aLineSpace = Split(aLine(iC), " ")
' As we have to indent the last bullet point line, call the finction to do that
sText = sText & SetIndentsInString(aLine(iC), STRING_LENGTH)
Else
sText = sText & aLine(iC) & vbCrLf
End If
Next
Me.txtBulletPoints.Text = sText
End If
End If
End Sub
Now add the below UDF where your form code is (essentially at the same place where your <textbox>_KeyUp function is):
Function SetIndentsInString(ByVal sString As String, ByVal iIndentLen As Long) As String
Dim iC As Long
Dim iLastTab As Long: iLastTab = 0
Dim aSpace() As String
Dim aTab() As String
Dim sCurString As String
' Check if the string is the same as what it was last
' time (sLastString is a private module variable initialised
' to "" when the form is activated)
If Replace(sString, vbTab, "") = Replace(sLastString, vbTab, "") Then
' Its the same string so lets return it as is
SetIndentsInString = sString
Else
' Its not the same string so set initial values
sLastString = sString
SetIndentsInString = ""
' Loop to see how many lines we have based on number of TABs in the string
Do While InStr(iLastTab + 1, sString, vbTab) > 0
iLastTab = iLastTab + InStr(iLastTab + 1, sString, vbTab)
Loop
' If there is only 1 TAB, simply indent the line
If iLastTab = 1 Then
aSpace = Split(sString, " ")
SetIndentsInString = Mid(sString, 1, Len(sString) - Len(aSpace(UBound(aSpace)))) & vbTab & " " & aSpace(UBound(aSpace))
Else
' More then 1 TAB.. damn!. Ok well lets work it
aTab = Split(sString, vbTab)
sCurString = aTab(UBound(aTab))
' Check if the last line of our bullet point has more characters then allowed in a line
If Len(sCurString) >= iIndentLen Then
' It does. Now loop through all the lines in our bullet point and set the last character in a new line with indent
aSpace = Split(sCurString, " ")
For iC = LBound(aTab) To UBound(aTab)
If iC = UBound(aTab) Then
SetIndentsInString = SetIndentsInString & Mid(sCurString, 1, Len(sCurString) - Len(aSpace(UBound(aSpace)))) & vbTab & " " & aSpace(UBound(aSpace))
Else
SetIndentsInString = SetIndentsInString & aTab(iC) & vbTab
End If
Next
Else
' It doesnt. Loop through and send the string back
SetIndentsInString = sString
End If
End If
End If
End Function
Now in the same module, make the following declaration at the top:
Private sLastString As String
Essentially the above will act like a bullet point as it would be in a Rich Text box. Things to remember is that you will have to set STRING_LENGTH to the number of characters your textbox will take in a given bullet point line (you will have to play around with that). Below is a screen print of how it worked for me
I have a subform, and it has a field with code source (custom VBA function doing a lookup). The filter button on that field doesn't work (Access by design). My users will want to use filters for this field and also for other fields.
As a workaround, I have added 3 checkboxes. If a user clicks any one of these checkboxes, filters get applied to the subform based on the function field.
The problem is, this removes all the other currently applied filters from the subform. This is not nice towards my users.
Is there a way to add and remove one field criteria to filtering without ruining the rest of the filter?
I have tried brute forcing it, but I gave up. When a filter gets added the normal way, many parentheses and AND words get added. My little filter text can be anywhere in a maze of filter criteria string. So using text functions to find it and manipulate it seems to be big, slow, stupid, unstable and dirty.
Am I missing something here? Any better way to do this?
Dim tx As String
If Not Me.flProcDONE And Not Me.flProcNOK And Not Me.flProcOK Then
tx = ""
Else
tx = "stProc IN (" & IIf(Me.flProcDONE, kStProcUPD, "99") _
& "," & IIf(Me.flProcNOK, kStProcNOK, "99") _
& "," & IIf(Me.flProcOK, kStProcOK, "99") & ")"
End If
With Me.sfrApply.Form
.Filter = tx
.FilterOn = True
End With
(Partly-working) brute force code:
With Me.sfrApply.Form
If .Filter = "" Then
.Filter = tx
Else
If tx = "" Then
lnStart = InStr(1, .Filter, "AND stProc IN (", vbTextCompare)
If lnStart > 0 Then
lnEnd = InStr(lnStart, .Filter, ")", vbTextCompare)
.Filter = Left(.Filter, lnStart - 1) & Mid(.Filter, lnEnd + 1)
End If
Else
lnStart = InStr(1, .Filter, "stProc", vbTextCompare)
If lnStart > 0 Then
lnEnd = InStr(lnStart, .Filter, ")", vbTextCompare)
.Filter = Left(.Filter, lnStart - 1) & tx & Mid(.Filter, lnEnd + 1)
Else
.Filter = "(" & .Filter & ") AND (" & tx & ")"
End If
End If
End If
.FilterOn = True
End With
It has a few errors, misses some parentheses. Making it work would require an additional 4-5 IFs and many more Instrs. Disgusting. Access filtering keeps adding [] and () to the filter text, that is what makes it near impossible to manipulate from the code.
A few examples of .Form.Filter texts:
"" - no filter
"stProc IN (99,99,1)" - the one I'm trying to manipulate
"([scrCarrierInvoiceGLSQuote].[ctParcelQUOTE] In (1,2))"
"((([stProc] In (99,99,1)))) AND ([scrCarrierInvoiceGLSQuote].[ctParcelSI]=1)"
"(([scrCarrierInvoiceGLSQuote].[ctParcelQUOTE] In (1,2))) AND (stProc IN (99,99,1))"
"((([scrCarrierInvoiceGLSQuote].[ctParcelQUOTE] In (1,2)) AND ([stProc] In (99,99,1)))) AND ([scrCarrierInvoiceGLSQuote].[lsError] Like "COD?")"
I would try something like
With Me.sfrApply.Form
.Filter = .Filter & " AND " & tx
.FilterOn = True
End With
This is just a quick sample but you can elaborate on that.
Well, I did manage to solve it. There was no nice way I have found. Basically:
If the filter string is empty, just add my filter string to it
If the filter part in question is not already in the filter string, just Concatenate it to the end of it (as #iDevlop suggested)
If the filter I'm about to apply is already part of the filter, just change the "IN(...)" part of it - never attempt to remove it.
Here is the code:
Dim txFullFilter As String
Dim txFilterPart As String
Dim lnStProcPos As Long 'Position of the column name in the existing filter text
Dim lnOpenParPos As Long 'Position of the opening parentheses "(" after column name
Dim lnCloseParPos As Long 'Position of the closing parentheses ")" after the opening one
'Create the actual filter text form the column I'm trying to filter from outside.
If Not Me.flProcDONE And Not Me.flProcNOK And Not Me.flProcOK Then
txFilterPart = "0,1,3,7"
Else
txFilterPart = IIf(Me.flProcDONE, kStProcUPD, "99") _
& "," & IIf(Me.flProcNOK, kStProcNOK, "99") _
& "," & IIf(Me.flProcOK, kStProcOK, "99")
End If
txFullFilter = "stProc IN (" & txFilterPart & ")"
'Apply said filter to the subform
With Me.sfrApply.Form
If .Filter = "" Then
.Filter = txFullFilter
ElseIf InStr(.Filter, "stProc") > 0 Then
lnStProcPos = InStr(.Filter, "stProc")
lnOpenParPos = InStr(lnStProcPos, .Filter, "(")
lnCloseParPos = InStr(lnOpenParPos, .Filter, ")")
.Filter = Left(.Filter, lnOpenParPos) & txFilterPart & Mid(.Filter, lnCloseParPos)
Else
.Filter = .Filter & "AND " & txFullFilter
End If
.FilterOn = True
End With
I'm trying to read a .csv to work with it in an .accdb
The file has ; as delimiter and "" as string qualifier.
Young and naive as I was I just split the file at the delimiter:
Set oFSO = New FileSystemObject
Set oStream = oFSO.OpenTextFile(sFilePath, ForReading)
Do Until oStream.AtEndOfStream
sLine = oStream.ReadLine
sArray = Split(sLine, ";")
....
Now I got a line that reads:
"String";"Str;ing";0;0;0;"String"
So I have delimiter inside one of the strings which makes the code above not work. Any ideas how to solve this?
EDIT:
I've found someone with a similar problem, only with a comma as delimiter. And they solved it using regular expressions.
The problem: I'm absolutely not good with regular expressions. In the example the used this expression and code:
Function regLine(sLine As String) As String
Dim oRegEx As RegExp
Set oRegEx = New RegExp
oRegEx.IgnoreCase = True
oRegEx.Global = True
' Pattern: ",(?=([^"]*"[^"]*")*(?![^"]*"))"
oRegEx.Pattern = ",(?=([^" & Chr(34) & "]*" & Chr(34) & "[^" & Chr(34) & "]*" & Chr(34) & ")*(?![^" & Chr(34) & "]*" & Chr(34) & "))"
regLine = oRegEx.Replace(sLine, ";")
End Function
So I don't really understand the expression. My first idea was to replace the comma with a semicolon but that didn't work.
Option Explicit
Dim line
line ="""String"";""Str;ing"";0;0;0;""String"""
WScript.Echo line
Dim aFields
With New RegExp
.Pattern = "(""[^""]*"")?;"
.Global = True
aFields = Split(.Replace(line, "$1"&Chr(0)),Chr(0))
End With
Dim field
For Each field In aFields
WScript.Echo field
Next
Code is .vbs, but shows how to use the regular expression to replace semicolons not enclosed in quotes with a null character and use the null character to split the line into its fields.
I solved the problem now by writing a loop, that deletes the delimiter if it is in a string.
Function fixLine(sLine As String)
Dim i As Long
Dim bInString As Boolean
bInString = False
fixLine = ""
For i = 1 To Len(sLine)
If Mid(sLine, i, 1) = Chr(34) Then
If bInString Then
bInString = False
Else
bInString = True
End If
End If
If bInString And Mid(sLine, i, 1) = ";" Then
Else
fixLine = fixLine & Mid(sLine, i, 1)
End If
Next
End Function
It kind of feels quick and dirty and I'm not sure about the performance but it works.
EDIT:
I also worked with theabove example I found. It replaces the delimiter in a line outside of strings. So I replaced the delimiter with Chr(0) which I know won't apear in a line and then split at the new delimiter.
Function regLine(sLine As String) As String()
Dim oRegEx As RegExp
Dim sLine2() As String
Set oRegEx = New RegExp
oRegEx.Global = True
'Pattern: ";(?=([^"]*"[^"]*")*(?![^"]*"))"
oRegEx.Pattern = ";(?=([^" & Chr(34) & "]*" & Chr(34) & "[^" & Chr(34) & "]*" & Chr(34) & ")*(?![^" & Chr(34) & "]*" & Chr(34) & "))"
sLine2 = oRegEx.Replace(sLine, Chr(0))
regLine = Split(sLine2, Chr(0))
End Function
My first question is: Is there any case where a ";" in the string values is a valid string? If so, I don't see any way other than manually verifying the data.
If not, how large is the input file? If it's not too big (for various definitions of "too" :-) ) then just manually scan it for errors.
If it is very large, I'd simple write a preprocesser program that reads the string values then deletes any ";" in those where it occurs. Such a program is only about a dozen lines long. Then run the clean file into Access.
I need to remove line breaks from the beginning of a memo type records. I dont want to use the replace function as it would remove all line breaks from the record which is not desired. Its only the line breaks at the beginning of the field that I am interested in removing.
Furthermore, the my records do not always begin with a line break so I cant really use text positioning, the solution would be to look for line break at the beginning instead of always expecting it at the beginning.
If Len(string) > 0 Then
Do While Left(string,1)= chr(13) Or Left(string,1)= chr(10) or Left(string,1) = " "
string = Right(string, len(string)-1)
Loop
End If
This will check to make sure the string isn't empty, then runs a simple loop to remove the left-most character as long as it is either a CR (chr(13)), LF (chr(10)), or a space (" ").
Once the loop hits the first character that doesn't match the criteria, it stops and you have the desired result of trimming all extra CR, LF, and space characters only from the beginning of the string.
Since it's relatively short, I just put it in the event procedure where needed, you could also modify it to be a public function in a module if you see fit.
Replace does not replace all occurences when you use the count argument: http://office.microsoft.com/en-us/access/HA012288981033.aspx
You can test it like so:
s1 = vbCrLf & "abc"
s2 = "ab" & vbCrLf & "c"
MsgBox "---" & IIf(Left(s1, 2) = vbCrLf, Replace(s1, vbCrLf, "", , 1), s1)
MsgBox "---" & IIf(Left(s2, 2) = vbCrLf, Replace(s2, vbCrLf, "", , 1), s2)
Improving upon what SBinVA wrote
The following code does not need the if statement and it is easy to expand to more character (space, tabs, etc.).
(It also assumes line breaks can originate from a file that can comes from other systems, so vbCr and vbLf are used separately, which takes care of all scenarios.)
Public Function trimCrOrLf(ByVal s As String) As String
Dim firstChar As String
firstChar = Left(s, 1)
Do While InStr(vbCr & vbLf, firstChar) > 0
s = Mid(s, 2)
firstChar = Left(s, 1)
Loop
trimCrOrLf = s
End Function
Consider a SQL UPDATE statement to discard only those CRLF at the beginning of each memo field.
UPDATE MyTable SET MyTable.memo_field = Mid([memo_field],3)
WHERE (((MyTable.memo_field) Like Chr(13) & Chr(10) & "*"));
Private Sub TestLineFeed()
Dim strString$, strTestChar, booStartsWith_CR As Boolean
strString = Chr$(13) & "some text"
strTestChar = "2"
'strTestChar = Chr$(13) ''This is a CR.
booStartsWith_CR = (Left(strString, 1) = strTestChar)
Debug.Print "-----"
Debug.Print "Raw: " & strString
Debug.Print booStartsWith_CR
If booStartsWith_CR Then
strString = Mid(strString, 2, 100)
End If
Debug.Print "-----"
Debug.Print "New: " & strString
End Sub
Note alternatives for strTestChar so you can see the action. You should notice "-----" in your Immediate Window is followed by a CR, thus a blank line; and this can be removed. Mid(strString, 2, 100) will need some tweaking, but the idea is to copy over your memo string without the first character.
I would use a function like this. It's fairly straight-forward and easily adapted to other circumstances. For example, to remove leading spaces too, add another test to the if (c = vbCr) line.
Function LTrimCRLF(s As String) As String
Dim index As Integer, start As Integer, strLen As Integer
Dim c As String
strLen = Len(s)
index = 1
start = -1
Do While (index <= strLen) And (start = -1)
c = Mid(s, index, 1)
If (c = vbCr) Or (c = vbLf) Then
index = index + 1
Else
start = index
End If
Loop
If start = -1 Then
LTrimCRLF = ""
Else
LTrimCRLF = Mid(s, start)
End If
End Function
Here's a test routine:
Sub TestLTrimCRLF()
Dim withWS As String, noWS As String, blank As String, onlyWS As String
withWS = vbCrLf & " this string has leading white space"
noWS = "this string has no leading white space"
onlyWS = vbCrLf & " " & vbCrLf & " "
blank = ""
Say "with WS: {" & LTrimCRLF(withWS) & "}"
Say "no WS: {" & LTrimCRLF(noWS) & "}"
Say "only WS: {" & LTrimCRLF(onlyWS) & "}"
Say "blank: {" & LTrimCRLF(blank) & "}"
End Sub
BTW, I tried looking at your sample data, but it says the document is not available. Maybe you need to make it public or something?
My contribution to VBA trimwhitespace() function, loop finds for first non-whitespace index, splits a string, then same thing for trailing whitespaces. Left+Right functions are run only once. If you need just leftTrim or rightTrim it's easy to introduce new arguments or separate functions.
Function trimWhitespace(str As String) As String
Dim idx As Long
Dim ch As String
' LeftTrim
If Len(str) > 0 Then
idx = 1
ch = Mid(str, idx, 1)
Do While ch = Chr(13) Or ch = Chr(10) Or ch = " "
idx = idx + 1
ch = Mid(str, idx, 1)
Loop
If (idx > 1) Then str = Right(str, Len(str) - idx)
End If
' RightTrim
idx = Len(str)
If idx > 0 Then
ch = Mid(str, idx, 1)
Do While ch = Chr(13) Or ch = Chr(10) Or ch = " "
idx = idx - 1
ch = Mid(str, idx, 1)
Loop
If (idx < Len(str)) Then str = Left(str, idx)
End If
trimWhitespace = str
End Function
This will trim all leading and trailing spaces, carriage returns, tabs, and other non-printable characters.
Public Function TrimSpecial(InputString As Variant) As String
' This will trim leading/trailing spaces and non-printable characters from the passed string.
Dim i As Integer
Dim str As String
On Error GoTo ErrorHandler
str = InputString
For i = 1 To Len(str)
If Asc(Mid(str, i, 1)) > 32 And Asc(Mid(str, i, 1)) < 127 Then
' Valid character found. Truncate leading characters before this.
str = Mid(str, i)
Exit For
End If
Next i
For i = Len(str) To 1 Step -1
If Asc(Mid(str, i, 1)) > 32 And Asc(Mid(str, i, 1)) < 127 Then
' Valid character found. Truncate trailing characters after this.
str = Mid(str, 1, i)
Exit For
End If
Next i
TrimSpecial = str
Exit_Function:
Exit Function
ErrorHandler:
MsgBox "Error #" & Err.Number & " - " & Err.Description & vbCrLf & "in procedure TrimSpecial"
GoTo Exit_Function
Resume Next
Resume
End Function
You can use this routine to test it:
Public Sub Test_TrimSpecial()
' Run this to test the TrimSpecial function.
Dim x As String
x = vbCrLf & " " & vbTab & " ab cd" & vbCrLf & vbTab & " xyz " & vbCr & vbCrLf
Debug.Print "-----"
Debug.Print ">" & x & "<"
Debug.Print "-----"
Debug.Print ">" & TrimSpecial(x) & "<"
Debug.Print "-----"
End Sub
Like "*" & Chr(13) & Chr(10)
(Access used carriage return + line feed, characters 13 and 10, for a new line).
To remove the carriage return/line feed, change the query to an update query and enter the following in the Update to line:
Replace([FieldName], Chr(13) & Chr(10), "")
or
Replace([FieldName], Chr(10),"")
Replace([FieldName], Chr(13),"")