How do I search attachments within outlook emails? I used to receive several emails a day and had to search each one. No problem. Now they are delivering one email with several attachments. How do I modify the code to search each attachment within each email?
Dim ws As New NotesUIWorkspace
Dim session As New NotesSession
Dim db As NotesDatabase
Dim uidoc As NotesUIDocument
Dim doc As NotesDocument
Dim Sto As String
Dim Cto As String
Dim Subject As String
Dim addsub As String
Dim Body As String
Dim addbody As String
Dim myItem As Variant
Dim I As Integer
Dim dotDoc As String
'Set uidoc = ws.Currentdocument
'Set doc = uidoc.document
'Outlook objects
Set appOutl = CreateObject("Outlook.Application")
Set myNameSpace = appOutl.GetNameSpace("MAPI")
Set MyFolder1 = myNameSpace.Folders(“Legacy Personal”)
Set MyFolder2 = MyFolder1.Folders(“Folder 1”)
Set MyFolder3 = MyFolder2.Folders(“Folder 2”)
’ the search strings
Dim a, b, c, d, e, f, g, h, k, l, m, n As String
a = "aaaa"
b = "bbbb"
c= "cccc"
d = "dddd"
e = "eeee"
f= "ffff"
g = "gggg"
h = "hhhh"
k = "kkkk"
l = "llll"
m = "mmmm"
n = "nnnn"
Dim NumItems As Integer
NumItems = MyFolder1.Items.Count
Set MyItems = MyFolder1.Items
Dim num As Integer
num% = Cint(Inputbox$(“How many days do you want to process?”, “Enter a number only” , “1”))
Dim temp As String
sDate = Date - num%
temp = “[ReceivedTime] >” + “'” + sDate + “'”
Set FilteredItems = MyItems.Restrict(temp)
'Msgbox filtereditems.count
Dim count As Integer
Dim lSubject As String, rSubject As String
Dim sCheckDups As String
Print "Processing"
count = 0
pathName$ = "c:\MSG\*.*"
pathNameb$ = "c:\MSG\"
fileName$ = Dir$(pathName$, 0)
Do While fileName$ <> ""
' Msgbox pathNameb$ + fileName$
Kill pathNameb$ + fileName$
fileName$ = Dir$()
Loop
Set wordapp = CreateObject("Word.Application")
For I = 1 To FilteredItems.count
If FilteredItems(I).UnRead Then
If Instr(1, FilteredItems(I).BODY, a, 1) > 0 Or Instr(1, FilteredItems(I).BODY, b, 1) > 0 Or Instr(1, FilteredItems(I).BODY, c, 1) > 0 Or Instr(1, FilteredItems(I).BODY, d, 1) > 0 Or Instr(1, FilteredItems(I).BODY, e, 1) > 0 Or Instr(1, FilteredItems(I).BODY, f, 1) > 0 Or Instr(1, FilteredItems(I).BODY, g, 1) > 0 Or Instr(1, FilteredItems(I).BODY, h, 1) > 0 Or Instr(1, FilteredItems(I).BODY, k, 1) > 0 Or Instr(1, FilteredItems(I).BODY, l, 1) > 0 Or Instr(1, FilteredItems(I).BODY, m, 1) > 0 Or Instr(1, FilteredItems(I).BODY, n, 1) > 0 Then
lSubject = Left$(FilteredItems(I).Subject, 20)
'rSubject = Right$(lSubject, 15)
rSubject = Left$(lSubject, 20)
sCheckDups = CheckForDuplicates(rSubject, pathName$)
If sCheckDups = "match" Then
rSubject = rSubject +"-" + Cstr(I)
End If
Call CreateWordDoc(rSubject, pathNameb$, FilteredItems(I).BODY)
Call CreateNotesDoc(rSubject ,pathNameb$)
FilteredItems(I).UnRead = False
FilteredItems(I).Save
End If
count = count +1
End If
Next