I need a macro that will look in a certain folder in Outlook and get
four-digit number from each e-mail. Basically, instead of the whol
e-mail including signatures and text, i just need the numbers. if i
is not possible to only get those from Outlook, maybe it would b
possible to pull all of the items in the folder to Excel, then pick ou
the numbers from there?
Thanks in advanc

--
Message posted from http://www.ExcelForum.com

There's plenty of code examples to find on how to enum
the outlook mails in a folder.

Have you looked for them?

Important: Are you using Redemption?
http://www.dimastr.com/redemption/
If it's on your own machine only I would install it.


Then ONCE we have a FOLDER object

we can loop thru the ITEMS
verify it's class is olMAILITEM
read the BODY

before i start coding this ..

Any way to identify those numbers?
Or is it basically reading the textstream until you find a four digit
number?

Are the emails PlainText or RTF or HTML?




--
keepITcool
| www.XLsupport.com | keepITcool chello nl | amsterdam


ForSale wrote :

I need a macro that will look in a certain folder in Outlook and get a
four-digit number from each e-mail. Basically, instead of the whole
e-mail including signatures and text, i just need the numbers. if it
is not possible to only get those from Outlook, maybe it would be
possible to pull all of the items in the folder to Excel, then pick
out the numbers from there?
Thanks in advance


---
Message posted from http://www.ExcelForum.com/

cool,
thanks for the help. i am not able to install Redeption as this is
work computer. also, each of the e-mails are different. they com
from a wide array of people, some who only put the info needed, som
add a lot of unnecessary stuff including signatures. i get e-mails i
all three formats.
each e-mail has to contain a few things and one of them is a four digi
number (ID number). all i need is the four digit numbers, and what
end up with is a bunch of pages of words that i don't need.
thanks agai

--
Message posted from http://www.ExcelForum.com

ForSale ..


You owe me :)


Edit the scanfolder's name.... it does inbox now ..
scanfolder CAN be \\store\folder\subfolder

if store is not specified it will pick the first available
store in the current session.

Problem with IDing a 4number string is that you'll find
that several phone numbers and dates will popup as well..

I've tried to find ALL occurances of 'four number words'
dumped in the activesheet

adapt as needed...
signing for tonite...email me for follow up.
somehow I think there will be some... :)

Have Fun!


--
keepITcool
| www.XLsupport.com | keepITcool chello nl | amsterdam


Option Explicit

Sub OutlookReader()
Dim olApp As Outlook.Application
Dim olSes As Outlook.NameSpace
Dim olFol As Outlook.MAPIFolder
Dim olObj As Object
Dim rdObj As Object

On Error GoTo errH:
Set olApp = CreateObject("Outlook.application")
Set olSes = olApp.Session

Set olFol = GetFolder(olSes, "Inbox")

For Each olObj In olFol.Items
If olObj.Class = olMail Then
'Set rdObj = CreateObject("Redemption.SafeMailItem")
'rdObj.Item = olObj
'Call FindID(rdObj)
Call FindID(olObj)
End If
Next

endH:
On Error Resume Next
'Cleanup Redemption
'Set rdObj = Nothing
'CreateObject("Redemption.MAPIUtils").Cleanup

Set olObj = Nothing
Set olFol = Nothing
Set olSes = Nothing
Set olApp = Nothing
Exit Sub

errH:


End Sub

'Returns the object from a path like \\Store\Folder\SubFolder
Function GetFolder(ByRef oSes As Outlook.NameSpace, ByVal sPath As
String) As MAPIFolder

Dim vArr, oFld, i%
On Error GoTo errH:
If Left(sPath, 2) < "\\" Then
sPath = oSes.Folders(1).FolderPath & IIf(Left(sPath, 1) = "\", "",
"\") & sPath
End If
vArr = Split(Replace(Replace(sPath, "/", "\"), "\\", ""), "\")

Set oFld = oSes.Folders(vArr(0))
If oFld Is Nothing Then Exit Function
For i = 1 To UBound(vArr)
Set oFld = oFld.Folders(vArr(i))
Next

Set GetFolder = oFld
Exit Function
errH:
MsgBox "Cant find folder " & sPath
End Function

Sub FindID(olMsg As Object)
Dim i&
Dim sMsg As String
Dim sRaw As String
Dim bFound As Boolean

sRaw = olMsg.Body
If sRaw Like "*####*" Then
sMsg = " " & sRaw & " "
If sMsg Like "*" & vbCrLf & "*" Then sMsg = Replace(sMsg, vbCrLf, "
")
If sMsg Like "*" & vbLf & "*" Then sMsg = Replace(sMsg, vbLf, " ")
If sMsg Like "*" & vbCr & "*" Then sMsg = Replace(sMsg, vbCr, " ")

For i = 1 To Len(sMsg) - 5
If Mid(sMsg, i, 6) Like " #### " Then
Call WriteID(olMsg, Mid(sMsg, i + 1, 4))
bFound = True
If Not Mid(sMsg, i + 6) Like "*#### *" Then Exit For
End If
Next
End If
If Not bFound Then Call WriteID(olMsg, "none")
End Sub

Sub WriteID(olMsg As Object, sID As String)
Static s_rng As Range
If s_rng Is Nothing Then
Set s_rng = ActiveSheet.Columns("A:A").Cells(2 ^ 16, 1).End(xlUp)
End If
Set s_rng = s_rng.Offset(1)
With s_rng
.Resize(1, 3) = Array(olMsg.SenderName, olMsg.Subject, sID)
End With
End Sub

Thanks cool,
I did get one error message on run-time:

Compile error:
User-defined type not defined.

when i hit okay, it highlights the line

Function GetFolder(ByRef oSes As Outlook.NameSpace, ByVal sPath A
String) As MAPIFolder

Any thoughts

--
Message posted from http://www.ExcelForum.com