Character Length between Point A and B

[markh1182]

Hi, How do I find out the length of characters between 2 points in an email message?

I have the following code that I am trying to amend so it selects the first email in a string of forwarded emails:

Sub PrintOnePage()

Dim mi As MailItem
Dim sBody As String
Dim wdApp As Word.Application
Dim lPos As Long

Const sORIG As String = "-----Original Message-----"

If TypeName(Application.ActiveInspector.CurrentItem) = "MailItem" Then 'only mail
'create a forward to get the header
Set mi = Application.ActiveInspector.CurrentItem.Forward
sBody = mi.Body

lPos = InStr(sBody, "-----Original Message-----")



sBody = Mid(sBody, lPos, 5000)
MsgBox sBody

mi.Close olDiscard 'don't save changes
Set mi = Nothing

End If

End Sub

I am wanting to get the number of characters between the first Original Message and the second Original Message. This is so I can set the length of 5000 to be accurate to the length of the first message in the string of forwards.

Hope this makes sense.

If not let me know and I'll try to be more clear.

Thanks, Mark

[Oorang]

This do it for you?
Option Explicit

Public Function Test()
Const strTestText As String = _
"test1 foo test2 Test1 bar Test2 Test1 baz Test2 test1 qux test2"
MsgBox GrabCenter(strTestText, "Test1 ", " Test2", False, False)
MsgBox GrabCenter(strTestText, "Test1 ", " Test2", True, False)
MsgBox GrabCenter(strTestText, "Test1 ", " Test2", True, True)
MsgBox GrabCenter(strTestText, "Test1 ", " Test2", False, True)
End Function

Public Function GrabCenter(ByVal text As String, _
ByVal startValue As String, _
ByVal terminatingValue As String, _
Optional ByVal caseSensitive As Boolean, _
Optional ByVal findLast As Boolean) As String
Dim lngStrtPos As Long
Dim lngTrmgPos As Long
Dim strRtnVal As String
If Not caseSensitive Then
text = LCase$(text)
startValue = LCase$(startValue)
terminatingValue = LCase$(terminatingValue)
End If
If findLast Then
lngStrtPos = InStrRev(text, startValue)
If lngStrtPos Then
lngTrmgPos = InStrRev(text, terminatingValue)
If lngTrmgPos Then
lngStrtPos = lngStrtPos + Len(startValue)
strRtnVal = Mid$(text, lngStrtPos, lngTrmgPos - lngStrtPos)
End If
End If
Else
lngStrtPos = InStrB(text, startValue)
If lngStrtPos Then
lngTrmgPos = InStrB(text, terminatingValue)
If lngTrmgPos Then
lngStrtPos = lngStrtPos + LenB(startValue)
strRtnVal = MidB$(text, lngStrtPos, lngTrmgPos - lngStrtPos)
End If
End If
End If
GrabCenter = strRtnVal
End Function

[Charlize]

?Sub PrintOnePage()
Dim mi As Outlook.MailItem
Dim sBody As String
Dim vloop As Long
Const sORIG As String = "-----Original Message-----"
'We select a message in the mailfolder
With ActiveExplorer.Selection
If .Count = 0 Then
MsgBox "No mail selected to be processed !", vbCritical
Exit Sub
ElseIf .Count > 1 Then
MsgBox "Only select 1 mail to be processed !", vbExclamation
Exit Sub
End If
Set mi = .item(1)
sBody = mi.Body
'We check on your searchstring
If InStr(1, sBody, sORIG) > 1 Then
'Loop through the messages. If there is one searchstring, you will
'have two messages, vloop will be 0 and 1. 0 for the answer and 1
'for the original message. So if you need the last, original message
'that has some forward messages you could use the ubound thing to
'extract the first initial message that has been send.
For vloop = LBound(Split(sBody, sORIG)) To UBound(Split(sBody, sORIG))
MsgBox Split(sBody, sORIG)(vloop)
Next vloop
Else
MsgBox "No forwarded message found"
End If
mi.Close olDiscard 'don't save changes
Set mi = Nothing
End With
End SubCharlize