Outlook vba match a pattern inside spreadsheet when attchement is found

[hartyshow]

I'm trying to match a pattern when a spreadsheet attachment is found in outlook. I can trigger the process for a spreadsheet attachment but don't know how to invoke the search through the attachment regex is inside attachment.
Regex="Olus" locate in Sheet 2 line D1




Public Sub saveAttachtoDisk(itm As Outlook.MailItem) Dim objAtt As Outlook.Attachment
Dim saveFolder As String
saveFolder = "C:\form"

For Each objAtt In itm.Attachments


If InStr(objAtt.DisplayName, ".xls") Then

"Regex=Tim Olus"

objAtt.SaveAsFile saveFolder & "\" & objAtt.DisplayName


Set objAtt = Nothing
End If



Next
End Sub

what do you think?

[gmayor]

Maybe something like

Option Explicit

Sub Test_With_Selected_Message()
Dim olMsg As MailItem
On Error Resume Next
Set olMsg = ActiveExplorer.Selection.Item(1)
saveAttachtoDisk olMsg
lbl_Exit:
Exit Sub
End Sub


Public Sub saveAttachtoDisk(itm As Outlook.MailItem)
Dim xlApp As Object
Dim xlBook As Object
Dim bStarted As Boolean
Dim objAtt As Outlook.Attachment
Const strText As String = "Tim Olus"
Const saveFolder As String = "C:\Path\"


For Each objAtt In itm.Attachments
If InStr(objAtt.fileName, ".xls") > 0 Then
objAtt.SaveAsFile saveFolder & objAtt.DisplayName
On Error Resume Next
Set xlApp = GetObject(, "Excel.Application")
If Err <> 0 Then
Set xlApp = CreateObject("Excel.Application")
bStarted = True
End If
On Error GoTo 0
'xlApp.Visible = True 'Optional while testing
Set xlBook = xlApp.workbooks.Open(saveFolder & objAtt.DisplayName)
If xlBook.sheets(2).Range("D1") = strText Then
MsgBox strText & " is found in " & xlBook.Name
'do something with the workbook
xlBook.Close 0
If bStarted Then xlApp.Quit
Else
MsgBox strText & " is not found " & xlBook.Name
xlBook.Close 0
If bStarted Then xlApp.Quit
End If
'Exit For
End If
Next objAtt
lbl_Exit:
Set objAtt = Nothing
Set xlApp = Nothing
Set xlBook = Nothing
Exit Sub
End Sub

[hartyshow]

this work fine



Public Sub saveAttachToDiskcvs(itm As Outlook.MailItem)

' --> Settings. change to suit
Const MASK = "Olus" ' Value to be found
Const SHEET = "sheet2" ' Sheet name or its index where to find
' <--

' Excel constants
Const xlValues = -4163, xlWhole = 1, xlPart = 2

' Variables
Dim objExcel As Object, IsNew As Boolean, x As Object
Dim objAtt As Outlook.Attachment
Dim saveFolder As String, sFileName As String, sPathName As String
saveFolder = "C:\form"

If Not TypeName(itm) = "MailItem" Then Exit Sub
If Dir(saveFolder, vbDirectory) = "" Then MkDir saveFolder

' Get/Create Excel object
On Error Resume Next
Set objExcel = GetObject(, "Excel.Application")
If Err Then
Err.Clear
IsNew = True
Set objExcel = CreateObject("Excel.Application")
End If
objExcel.FindFormat.Clear

' Main
For Each objAtt In itm.Attachments
sFileName = LCase(objAtt.FileName)
If sFileName Like "*.xls" Or sFileName Like "*.xls?" Then
sPathName = saveFolder & "\" & sFileName
objAtt.SaveAsFile sPathName
With objExcel.workbooks.Open(sPathName, ReadOnly:=True)
Set x = .sheets(SHEET).UsedRange.Find(MASK, LookIn:=xlValues, LookAt:=xlPart)
If x Is Nothing Then Kill sPathName Else Set x = Nothing
.Close False
End With
End If
Next

If IsNew Then objExcel.Quit

End Sub

but I'm having a problem converting the attachment in csv format after the regex is found




if WScript.Arguments.Count < 2 Then
WScript.Echo "Error! Please specify the source path and the destination. Usage: XlsToCsv SourcePath.xls Destination.csv"
Wscript.Quit
End If
Dim oExcel
Set oExcel = CreateObject("Excel.Application")
Dim oBook
Set oBook = oExcel.Workbooks.Open(Wscript.Arguments.Item(0))
oBook.SaveAs WScript.Arguments.Item(1), 6
oBook.Close False
oExcel.Quit
WScript.Echo "Done"

what do you think?