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?