-
Character Length between Point A and B
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:
[vba]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[/vba]
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
-
This do it for you?
[vba]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[/vba]
Cordially,
Aaron
Keep Our Board Clean! - Please Mark your thread "Solved" if you get an acceptable response (under thread tools).
- Enclose your code in VBA tags then it will be formatted as per the VBIDE to improve readability.
-
?[VBA]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 Sub[/VBA]Charlize
Posting Permissions
- You may not post new threads
- You may not post replies
- You may not post attachments
- You may not edit your posts
-
Forum Rules