Hello Access Group:

I'm trying to find a faster way to eliminate non-printable characters from a 
memo field.  I have an Access application that reads email from Outlook and 
for certain messages saves the text of the message into a table in a Memo 
field.  The issue is that so many emails have embedded characters that if 
copied straight to the memo field show up as black rectangles 
(non-printable).  It's not pretty sight when trying to read through the 
jumble of black boxes.

So I was able to write a routine that loops through every character of the 
email text and eliminates the non-printables by copying only valid characters 
(character-by-character) to a variant data type, then when finished, copying 
the variant to the table's memo field.

Here's a snippet of code

' ************************************************************
' Microsoft Access Code After Reading an Outlook Email Message
' ************************************************************
Dim varCleanBody As Variant
Dim i As Long
Dim intConvertedToOctal As Integer
' Note - EmailText is Defined As a Memo Field in a Table

' ****************************************************
' Scan Through Each Character Of An Email Message
' And Eliminate Non-Printing Characters
' (Keep CR/LF which is Octal 12 and 15)
' By Only Moving Printable Characters To varCleanBody
' Then moves the filtered results from varCleanBody 
' to Table Field "EmailText" Which is Defined as Memo
' ****************************************************
varCleanBody = ""
For i = 1 To Len(Mailobject.Body)
	intConvertedToOctal = Oct(Asc(Mid(Mailobject.Body, i, 1)))
	If (intConvertedToOctal = 12 Or intConvertedToOctal = 15 Or _
	    intConvertedToOctal > 37) Then
	    varCleanBody = varCleanBody & Mid(Mailobject.Body, i, 1)
	End If
Next i
recOut!EmailText = varCleanBody

This code works but it takes an extremely long time to run.
-- 
Rich Locus
Logicwurks, LLC

Suggestions to make that code more efficient:
1. Operate on strings rather than variants.
2. Reduce the number of function calls.
3. Use Select Case as a way of defining the acceptable characters.
4. Declare your data types to match the functions you are calling (Longs 
rather than integers here.)

Function PrintableOnly(ByVal strIn As String) As String
    Dim i As Long
    Dim strOut As String
    Dim strChar As String

    For i = 1& To Len(strIn)
        strChar = Mid(strIn, i, 1&)
        Select Case Asc(strChar)
        Case 10, 13, Is >= 32
            strOut = strOut & strChar
        End Select
    Next
    PrintableOnly = strOut
End Function

-- 
Allen Browne - Microsoft MVP.  Perth, Western Australia
Tips for Access users - http://allenbrowne.com/tips.html
Reply to group, rather than allenbrowne at mvps dot org.


"Rich Locus" <RichLocus@discussions.microsoft.com> wrote in message 
news:11B55DFB-71EB-4F2B-96B5-6A34405790D4@microsoft.com...
> Hello Access Group:
>
> I'm trying to find a faster way to eliminate non-printable characters from 
> a
> memo field.  I have an Access application that reads email from Outlook 
> and
> for certain messages saves the text of the message into a table in a Memo
> field.  The issue is that so many emails have embedded characters that if
> copied straight to the memo field show up as black rectangles
> (non-printable).  It's not pretty sight when trying to read through the
> jumble of black boxes.
>
> So I was able to write a routine that loops through every character of the
> email text and eliminates the non-printables by copying only valid 
> characters
> (character-by-character) to a variant data type, then when finished, 
> copying
> the variant to the table's memo field.
>
> Here's a snippet of code
>
> ' ************************************************************
> ' Microsoft Access Code After Reading an Outlook Email Message
> ' ************************************************************
> Dim varCleanBody As Variant
> Dim i As Long
> Dim intConvertedToOctal As Integer
> ' Note - EmailText is Defined As a Memo Field in a Table
>
> ' ****************************************************
> ' Scan Through Each Character Of An Email Message
> ' And Eliminate Non-Printing Characters
> ' (Keep CR/LF which is Octal 12 and 15)
> ' By Only Moving Printable Characters To varCleanBody
> ' Then moves the filtered results from varCleanBody
> ' to Table Field "EmailText" Which is Defined as Memo
> ' ****************************************************
> varCleanBody = ""
> For i = 1 To Len(Mailobject.Body)
> intConvertedToOctal = Oct(Asc(Mid(Mailobject.Body, i, 1)))
> If (intConvertedToOctal = 12 Or intConvertedToOctal = 15 Or _
>     intConvertedToOctal > 37) Then
>     varCleanBody = varCleanBody & Mid(Mailobject.Body, i, 1)
> End If
> Next i
> recOut!EmailText = varCleanBody
>
> This code works but it takes an extremely long time to run.
> -- 
> Rich Locus
> Logicwurks, LLC 

And, now that it's cleaned up, you probably want to
include 9 as well as 10 and 13:

        Case 9, 10, 13, Is >= 32

9 is the tab character, and it is printable.

(david)


"Allen Browne" <AllenBrowne@SeeSig.Invalid> wrote in message 
news:ODLTU1z8KHA.5476@TK2MSFTNGP06.phx.gbl...
> Suggestions to make that code more efficient:
> 1. Operate on strings rather than variants.
> 2. Reduce the number of function calls.
> 3. Use Select Case as a way of defining the acceptable characters.
> 4. Declare your data types to match the functions you are calling (Longs 
> rather than integers here.)
>
> Function PrintableOnly(ByVal strIn As String) As String
>    Dim i As Long
>    Dim strOut As String
>    Dim strChar As String
>
>    For i = 1& To Len(strIn)
>        strChar = Mid(strIn, i, 1&)
>        Select Case Asc(strChar)
>        Case 10, 13, Is >= 32
>            strOut = strOut & strChar
>        End Select
>    Next
>    PrintableOnly = strOut
> End Function
>
> -- 
> Allen Browne - Microsoft MVP.  Perth, Western Australia
> Tips for Access users - http://allenbrowne.com/tips.html
> Reply to group, rather than allenbrowne at mvps dot org.
>
>
> "Rich Locus" <RichLocus@discussions.microsoft.com> wrote in message 
> news:11B55DFB-71EB-4F2B-96B5-6A34405790D4@microsoft.com...
>> Hello Access Group:
>>
>> I'm trying to find a faster way to eliminate non-printable characters 
>> from a
>> memo field.  I have an Access application that reads email from Outlook 
>> and
>> for certain messages saves the text of the message into a table in a Memo
>> field.  The issue is that so many emails have embedded characters that if
>> copied straight to the memo field show up as black rectangles
>> (non-printable).  It's not pretty sight when trying to read through the
>> jumble of black boxes.
>>
>> So I was able to write a routine that loops through every character of 
>> the
>> email text and eliminates the non-printables by copying only valid 
>> characters
>> (character-by-character) to a variant data type, then when finished, 
>> copying
>> the variant to the table's memo field.
>>
>> Here's a snippet of code
>>
>> ' ************************************************************
>> ' Microsoft Access Code After Reading an Outlook Email Message
>> ' ************************************************************
>> Dim varCleanBody As Variant
>> Dim i As Long
>> Dim intConvertedToOctal As Integer
>> ' Note - EmailText is Defined As a Memo Field in a Table
>>
>> ' ****************************************************
>> ' Scan Through Each Character Of An Email Message
>> ' And Eliminate Non-Printing Characters
>> ' (Keep CR/LF which is Octal 12 and 15)
>> ' By Only Moving Printable Characters To varCleanBody
>> ' Then moves the filtered results from varCleanBody
>> ' to Table Field "EmailText" Which is Defined as Memo
>> ' ****************************************************
>> varCleanBody = ""
>> For i = 1 To Len(Mailobject.Body)
>> intConvertedToOctal = Oct(Asc(Mid(Mailobject.Body, i, 1)))
>> If (intConvertedToOctal = 12 Or intConvertedToOctal = 15 Or _
>>     intConvertedToOctal > 37) Then
>>     varCleanBody = varCleanBody & Mid(Mailobject.Body, i, 1)
>> End If
>> Next i
>> recOut!EmailText = varCleanBody
>>
>> This code works but it takes an extremely long time to run.
>> -- 
>> Rich Locus
>> Logicwurks, LLC
> 

I would give a try to a double index run, in order to create a lot of 
strings (trough concatenation in a loop).


Function PrintableOnly(ByVal strIn As String) As String
    Dim i As Long ' where I am to read
    Dim j as Long ' where I am to write
    ' Dim strOut As String
    Dim strChar As String

    j =    0  ' intialize explicitly (not required but for completeness)

    For i = 1& To Len(strIn)
        strChar = Mid$(strIn, i, 1&)

        Select Case Asc(strChar)
            Case 9, 10, 13, Is >= 32

                j=j+1
                Mid$(strIn, j, 1)  = strChar

         End Select

    Next

    PrintableOnly = Left$(strIn, j ) ' shorter string, now

End Function



The advantage is that is uses only one string, ever (Concatenation trough a 
loop may end up by exceeding the reserved space, buffer, and force another 
string creation). Note that when the character is not printable,  j  is not 
increased, so the next position to be filled, j+1, is still 'free' to accept 
the next printable character (or CR, LF), which makes the algorithm like 
sliding one character at a time, into proper place. I also use the $ string 
function to avoid possible VBA automatic casting to 'variant'.


The ByVal is important, in the argument, else, the original string would 
have been modified, but if the original string does not matter, you may save 
few micro seconds by using ByRef instead (and while you are at it, change 
the Function to a Sub, since the result will be the 'initial variable' which 
would have been modified... but those micro optimizations are probably 
without human perceptible effect as runtime execution is concerned, and too 
error prone if used in another context, without remembering all the involved 
details).




Vanderghast, Access MVP


"david" <david@nospam.nospam> wrote in message 
news:O3O7ne18KHA.1892@TK2MSFTNGP05.phx.gbl...
> And, now that it's cleaned up, you probably want to
> include 9 as well as 10 and 13:
>
>        Case 9, 10, 13, Is >= 32
>
> 9 is the tab character, and it is printable.
>
> (david)
>
>
> "Allen Browne" <AllenBrowne@SeeSig.Invalid> wrote in message 
> news:ODLTU1z8KHA.5476@TK2MSFTNGP06.phx.gbl...
>> Suggestions to make that code more efficient:
>> 1. Operate on strings rather than variants.
>> 2. Reduce the number of function calls.
>> 3. Use Select Case as a way of defining the acceptable characters.
>> 4. Declare your data types to match the functions you are calling (Longs 
>> rather than integers here.)
>>
>> Function PrintableOnly(ByVal strIn As String) As String
>>    Dim i As Long
>>    Dim strOut As String
>>    Dim strChar As String
>>
>>    For i = 1& To Len(strIn)
>>        strChar = Mid(strIn, i, 1&)
>>        Select Case Asc(strChar)
>>        Case 10, 13, Is >= 32
>>            strOut = strOut & strChar
>>        End Select
>>    Next
>>    PrintableOnly = strOut
>> End Function
>>
>> -- 
>> Allen Browne - Microsoft MVP.  Perth, Western Australia
>> Tips for Access users - http://allenbrowne.com/tips.html
>> Reply to group, rather than allenbrowne at mvps dot org.
>>
>>
>> "Rich Locus" <RichLocus@discussions.microsoft.com> wrote in message 
>> news:11B55DFB-71EB-4F2B-96B5-6A34405790D4@microsoft.com...
>>> Hello Access Group:
>>>
>>> I'm trying to find a faster way to eliminate non-printable characters 
>>> from a
>>> memo field.  I have an Access application that reads email from Outlook 
>>> and
>>> for certain messages saves the text of the message into a table in a 
>>> Memo
>>> field.  The issue is that so many emails have embedded characters that 
>>> if
>>> copied straight to the memo field show up as black rectangles
>>> (non-printable).  It's not pretty sight when trying to read through the
>>> jumble of black boxes.
>>>
>>> So I was able to write a routine that loops through every character of 
>>> the
>>> email text and eliminates the non-printables by copying only valid 
>>> characters
>>> (character-by-character) to a variant data type, then when finished, 
>>> copying
>>> the variant to the table's memo field.
>>>
>>> Here's a snippet of code
>>>
>>> ' ************************************************************
>>> ' Microsoft Access Code After Reading an Outlook Email Message
>>> ' ************************************************************
>>> Dim varCleanBody As Variant
>>> Dim i As Long
>>> Dim intConvertedToOctal As Integer
>>> ' Note - EmailText is Defined As a Memo Field in a Table
>>>
>>> ' ****************************************************
>>> ' Scan Through Each Character Of An Email Message
>>> ' And Eliminate Non-Printing Characters
>>> ' (Keep CR/LF which is Octal 12 and 15)
>>> ' By Only Moving Printable Characters To varCleanBody
>>> ' Then moves the filtered results from varCleanBody
>>> ' to Table Field "EmailText" Which is Defined as Memo
>>> ' ****************************************************
>>> varCleanBody = ""
>>> For i = 1 To Len(Mailobject.Body)
>>> intConvertedToOctal = Oct(Asc(Mid(Mailobject.Body, i, 1)))
>>> If (intConvertedToOctal = 12 Or intConvertedToOctal = 15 Or _
>>>     intConvertedToOctal > 37) Then
>>>     varCleanBody = varCleanBody & Mid(Mailobject.Body, i, 1)
>>> End If
>>> Next i
>>> recOut!EmailText = varCleanBody
>>>
>>> This code works but it takes an extremely long time to run.
>>> -- 
>>> Rich Locus
>>> Logicwurks, LLC
>>
>
> 

To All of you that helped, THANKS!  These are good suggestions and I'm going 
to run with them.
-- 
Rich Locus
Logicwurks, LLC


"Allen Browne" wrote:

> Suggestions to make that code more efficient:
> 1. Operate on strings rather than variants.
> 2. Reduce the number of function calls.
> 3. Use Select Case as a way of defining the acceptable characters.
> 4. Declare your data types to match the functions you are calling (Longs 
> rather than integers here.)
> 
> Function PrintableOnly(ByVal strIn As String) As String
>     Dim i As Long
>     Dim strOut As String
>     Dim strChar As String
> 
>     For i = 1& To Len(strIn)
>         strChar = Mid(strIn, i, 1&)
>         Select Case Asc(strChar)
>         Case 10, 13, Is >= 32
>             strOut = strOut & strChar
>         End Select
>     Next
>     PrintableOnly = strOut
> End Function
> 
> -- 
> Allen Browne - Microsoft MVP.  Perth, Western Australia
> Tips for Access users - http://allenbrowne.com/tips.html
> Reply to group, rather than allenbrowne at mvps dot org.
> 
> 
> "Rich Locus" <RichLocus@discussions.microsoft.com> wrote in message 
> news:11B55DFB-71EB-4F2B-96B5-6A34405790D4@microsoft.com...
> > Hello Access Group:
> >
> > I'm trying to find a faster way to eliminate non-printable characters from 
> > a
> > memo field.  I have an Access application that reads email from Outlook 
> > and
> > for certain messages saves the text of the message into a table in a Memo
> > field.  The issue is that so many emails have embedded characters that if
> > copied straight to the memo field show up as black rectangles
> > (non-printable).  It's not pretty sight when trying to read through the
> > jumble of black boxes.
> >
> > So I was able to write a routine that loops through every character of the
> > email text and eliminates the non-printables by copying only valid 
> > characters
> > (character-by-character) to a variant data type, then when finished, 
> > copying
> > the variant to the table's memo field.
> >
> > Here's a snippet of code
> >
> > ' ************************************************************
> > ' Microsoft Access Code After Reading an Outlook Email Message
> > ' ************************************************************
> > Dim varCleanBody As Variant
> > Dim i As Long
> > Dim intConvertedToOctal As Integer
> > ' Note - EmailText is Defined As a Memo Field in a Table
> >
> > ' ****************************************************
> > ' Scan Through Each Character Of An Email Message
> > ' And Eliminate Non-Printing Characters
> > ' (Keep CR/LF which is Octal 12 and 15)
> > ' By Only Moving Printable Characters To varCleanBody
> > ' Then moves the filtered results from varCleanBody
> > ' to Table Field "EmailText" Which is Defined as Memo
> > ' ****************************************************
> > varCleanBody = ""
> > For i = 1 To Len(Mailobject.Body)
> > intConvertedToOctal = Oct(Asc(Mid(Mailobject.Body, i, 1)))
> > If (intConvertedToOctal = 12 Or intConvertedToOctal = 15 Or _
> >     intConvertedToOctal > 37) Then
> >     varCleanBody = varCleanBody & Mid(Mailobject.Body, i, 1)
> > End If
> > Next i
> > recOut!EmailText = varCleanBody
> >
> > This code works but it takes an extremely long time to run.
> > -- 
> > Rich Locus
> > Logicwurks, LLC 
> 
> .
> 

Thanks again:
For All of you that helped me redesign the non-printable character stripper, 
the time for a typical run went from 10 minutes down to 2 seconds... amazing.

Here's the final code with your suggestions.  It reads all mail in the 
Outlook Inbox, and for those items with a subject line of "Client" adds the 
mail to a database table after it has cleaned the non-printables in the 
message body.  It moves the mail from the inbox to one of two other 
historical folders.

Option Compare Database
Option Explicit

Public Function ReadInboxAndMoveWithCharReplaceV3()
Dim TempRst As DAO.Recordset
Dim OlApp As Outlook.Application
Dim Inbox As Outlook.MAPIFolder
Dim SavedMailFolder As Outlook.MAPIFolder
Dim RejectMailFolder As Outlook.MAPIFolder
Dim InboxItems As Outlook.Items
Dim SavedMailItems As Outlook.MailItem
Dim RejectMailItems As Outlook.MailItem
Dim Mailobject As Object
Dim db As DAO.Database
Dim i As Long

'DoCmd.SetWarnings False
'DoCmd.RunSQL "Delete * from tbl_outlooktemp"
'DoCmd.SetWarnings True

Set db = CurrentDb

Set OlApp = CreateObject("Outlook.Application")
Set Inbox = OlApp.GetNamespace("Mapi").GetDefaultFolder(olFolderInbox)
Set SavedMailFolder = 
OlApp.GetNamespace("Mapi").GetDefaultFolder(olFolderInbox).Parent.Folders("Saved Mail")
Set RejectMailFolder = 
OlApp.GetNamespace("Mapi").GetDefaultFolder(olFolderInbox).Parent.Folders("Rejects")
Set TempRst = CurrentDb.OpenRecordset("tbl_OutlookTemp")
'

Set InboxItems = Inbox.Items

dteUpdateTime = Date + Time
intUpdateCount = 0

For i = InboxItems.Count To 1 Step -1
    Set Mailobject = InboxItems(i)
    
    If UCase(Left(Mailobject.Subject, 6)) <> "CLIENT" Then
        Mailobject.UnRead = False
        Set SavedMailItems = Mailobject.Move(RejectMailFolder)
        intUpdateCount = intUpdateCount + 1
    Else
        With TempRst
            .AddNew
            !Subject = Mailobject.Subject
            !from = Mailobject.SenderName
            !To = Mailobject.To
            !Body = PrintableOnly(Mailobject.Body)
            !DateSent = Mailobject.SentOn
            .Update
            Mailobject.UnRead = False
            Set SavedMailItems = Mailobject.Move(SavedMailFolder)
            intUpdateCount = intUpdateCount + 1
        End With
    End If
Next

Set TempRst = Nothing
Set OlApp = Nothing
Set Inbox = Nothing
Set SavedMailFolder = Nothing
Set InboxItems = Nothing
Set SavedMailItems = Nothing
Set Mailobject = Nothing

End Function

Function PrintableOnly(ByVal strIn As String) As String
Dim i As Long ' where I am to read
Dim j As Long ' where I am to write

Dim strChar As String

j = 0 ' intialize explicitly (not required but for completeness)

For i = 1& To Len(strIn)
    strChar = Mid$(strIn, i, 1&)
    Select Case Asc(strChar)
        Case 10, 13, Is >= 32
        j = j + 1
        Mid$(strIn, j, 1) = strChar
    End Select
Next

PrintableOnly = Left$(strIn, j)  ' shorter string, now

End Function


-- 
Rich Locus
Logicwurks, LLC


"Rich Locus" wrote:

> Hello Access Group:
> 
> I'm trying to find a faster way to eliminate non-printable characters from a 
> memo field.  I have an Access application that reads email from Outlook and 
> for certain messages saves the text of the message into a table in a Memo 
> field.  The issue is that so many emails have embedded characters that if 
> copied straight to the memo field show up as black rectangles 
> (non-printable).  It's not pretty sight when trying to read through the 
> jumble of black boxes.
> 
> So I was able to write a routine that loops through every character of the 
> email text and eliminates the non-printables by copying only valid characters 
> (character-by-character) to a variant data type, then when finished, copying 
> the variant to the table's memo field.
> 
> Here's a snippet of code
> 
> ' ************************************************************
> ' Microsoft Access Code After Reading an Outlook Email Message
> ' ************************************************************
> Dim varCleanBody As Variant
> Dim i As Long
> Dim intConvertedToOctal As Integer
> ' Note - EmailText is Defined As a Memo Field in a Table
> 
> ' ****************************************************
> ' Scan Through Each Character Of An Email Message
> ' And Eliminate Non-Printing Characters
> ' (Keep CR/LF which is Octal 12 and 15)
> ' By Only Moving Printable Characters To varCleanBody
> ' Then moves the filtered results from varCleanBody 
> ' to Table Field "EmailText" Which is Defined as Memo
> ' ****************************************************
> varCleanBody = ""
> For i = 1 To Len(Mailobject.Body)
> 	intConvertedToOctal = Oct(Asc(Mid(Mailobject.Body, i, 1)))
> 	If (intConvertedToOctal = 12 Or intConvertedToOctal = 15 Or _
> 	    intConvertedToOctal > 37) Then
> 	    varCleanBody = varCleanBody & Mid(Mailobject.Body, i, 1)
> 	End If
> Next i
> recOut!EmailText = varCleanBody
> 
> This code works but it takes an extremely long time to run.
> -- 
> Rich Locus
> Logicwurks, LLC