I can't code well at all but I am trying to get this to work

I managed to cobble this together from a friend's help. Now I don't know how to finish it now that he can't help. If you have ANY idea what to do or what the problem may be, that would be great

Code:

---

Sub SearchEmails()
Dim oExcel As Excel.Application
Dim oWorkbook As Excel.Workbook
Dim oWorksheet As Excel.Worksheet
Dim oRange As Excel.Range
Dim oItem As Object
Dim sEmail As String
Dim sPath As String
Dim sSpreadsheet As String
Dim sFilter As String
Dim oMail As MailItem 
'Specify the path to the spreadsheet 'For example: "C:\Users\Bob\Documents\Emails.xlsx" sSpreadsheet = "S:\Marshall Wu\test file.xlsx" 
'Create an instance of Excel and open the spreadsheet
Set oExcel = CreateObject("Excel.Application")
Set oWorkbook = oExcel.Workbooks.Open(sSpreadsheet)
Set oWorksheet = oWorkbook.Worksheets(1) 
'Get the range of cells you want to read from 'For example: "A1:B10"
Set oRange = oWorksheet.Range("A1:B10") 
'Loop through the cells in the range
For Each oItem In oRange.Cells
  'Read the email address and file path from the cells
  sEmail = oItem.Value
  sPath = oItem.Offset(0, 1).Value
  'Print the values of sEmail and sPath to the immediate window
  Debug.Print "Email: " & sEmail & ", Path: " & sPath
  'Build the search filter
  sFilter = "[SenderEmailAddress] = '" & sEmail & "'"
  'Search the mailbox for emails from the specified sender
      For Each oMail In Outlook.Application.Session.GetDefaultFolder(olFolderAllFolders).Items.Restrict(sFilter)
          'Save the email to the specified folder

  oMail.SaveAs sPath & "" & oMail.Subject & ".msg"
Next
Next 
'Close the spreadsheet and quit Excel
oWorkbook.Close
oExcel.Quit
End Sub

---

When I run the code, this error message appears: "Run-time error '-2147024809 (80070057)': Sorry, something went wrong. You may want to try again." When I click debug, it highlights this line "For Each oMail In Outlook.Application.Session.GetDefaultFolder(olFolderAllFolders).Items.Rest rict(sFilter)"

Yay! I have no idea what is going on!

This is what I have been trying to get this code to do. Read a from an excel spreadsheet and search my outlook mailbox from the data contained in the cells. And in the spreadsheet, column A will contain one or more email addresses. Column B will contain a file path. This code will search my outlook mailbox for these email addresses. For each entry in column A, save all search results to the file path listed in column B.


:) I have no idea how to fix it or make this work

olFolderAllFolders is not a valid Outlook folder. Either enter the correct folder e.g. olFolderInbox or loop hrough all the available folders.
Your code makes no allowances for illegal filename characters in the message subject or for duplicated subjects. The former will crash the code. The latter will overwrite the earlier message.
See http://www.gmayor.com/save_messages_from_outlook.html

Oh... thank you for the link but I have NO experience working with code at all. Do you know how I could combine that and fix that then?

The following will create unique messages from Inbox in the folder indicated in column B of the worksheet that relate to the e-mail address in column A from rows 1 to 10.
The folder must be a complete folder path which will be created if not already present e.g. C:\Path\Foldername\

Code:

---

Option Explicit

Sub SearchEmails()
Dim oExcel As Object
Dim oWorkbook As Object
Dim oWorksheet As Object
Dim oRange As Object
Dim oItem As Object
Dim sEmail As String
Dim sPath As String
Dim sName As String
Dim sSpreadsheet As String
Dim sFilter As String
Dim oMail As MailItem
    'Specify the path to the spreadsheet 'For example: "C:\Users\Bob\Documents\Emails.xlsx"
    sSpreadsheet = "S:\Marshall Wu\test file.xlsx"
   
    'Create an instance of Excel and open the spreadsheet
    Set oExcel = CreateObject("Excel.Application")
    Set oWorkbook = oExcel.Workbooks.Open(sSpreadsheet)
    Set oWorksheet = oWorkbook.Worksheets(1)
    oExcel.Visible = True
    'Get the range of cells you want to read from 'For example: "A1:A10"
    Set oRange = oWorksheet.Range("A1:A10")
    'Loop through the cells in the range
    For Each oItem In oRange.cells
        'Read the email address and file path from the cells
        sEmail = oItem.Value
        sPath = oItem.Offset(0, 1).Value
        Do Until Right(sPath, 1) = "\"
            sPath = sPath & "\"
        Loop
        'Print the values of sEmail and sPath to the immediate window
        'Debug.Print "Email: " & sEmail & ", Path: " & sPath
        'Build the search filter
        sFilter = "[SenderEmailAddress] = '" & sEmail & "'"
        'Search the mailbox for emails from the specified sender
        For Each oMail In Outlook.Application.Session.GetDefaultFolder(olFolderInbox).Items.Restrict(sFilter)
            'Save the email to the specified folder
            sName = CleanFileName(oMail.Subject)
            SaveUnique oMail, sPath, sName
        Next
    Next
    'Close the spreadsheet and quit Excel
lbl_Exit:
    oWorkbook.Close
    oExcel.Quit
    Set oWorkbook = Nothing
    Set oExcel = Nothing
    Set oWorksheet = Nothing
    Set oItem = Nothing
    Set oMail = Nothing
    Exit Sub
End Sub

Private Function SaveUnique(oItem As Object, _
                            strPath As String, _
                            strFileName As String)
'An Outlook macro by Graham Mayor - www.gmayor.com
'Ensures that filenames are not overwritten
Dim lngF As Long
Dim lngName As Long
Dim FSO As Object
    Set FSO = CreateObject("Scripting.FileSystemObject")
    lngF = 1
    lngName = Len(strFileName)
    Do While FSO.FileExists(strPath & strFileName & ".msg") = True
        strFileName = Left(strFileName, lngName) & "(" & lngF & ")"
        lngF = lngF + 1
    Loop
    CreateFolders strPath
    oItem.SaveAs strPath & strFileName & ".msg"    '".txt", olTXT
lbl_Exit:
    Exit Function
End Function

Private Sub CreateFolders(strPath As String)
'A Graham Mayor/Greg Maxey AddIn Utility Macro
Dim oFSO As Object
Dim lng_PathSep As Long
Dim lng_PS As Long
    If Right(strPath, 1) <> "\" Then strPath = strPath & "\"
    lng_PathSep = InStr(3, strPath, "\")
    If lng_PathSep = 0 Then GoTo lbl_Exit
    Set oFSO = CreateObject("Scripting.FileSystemObject")
    Do
        lng_PS = lng_PathSep
        lng_PathSep = InStr(lng_PS + 1, strPath, "\")
        If lng_PathSep = 0 Then Exit Do
        If Len(Dir(Left(strPath, lng_PathSep), vbDirectory)) = 0 Then Exit Do
    Loop
    Do Until lng_PathSep = 0
        If Not oFSO.FolderExists(Left(strPath, lng_PathSep)) Then
            oFSO.CreateFolder Left(strPath, lng_PathSep)
        End If
        lng_PS = lng_PathSep
        lng_PathSep = InStr(lng_PS + 1, strPath, "\")
    Loop
lbl_Exit:
    Set oFSO = Nothing
    Exit Sub
End Sub

Private Function CleanFileName(strFileName As String) As String
Dim arrInvalid() As String
Dim lng_Index As Long
    'Define illegal characters (by ASCII CharNum)
    arrInvalid = Split("9|10|11|13|34|42|47|58|60|62|63|92|124", "|")
    'Remove any illegal filename characters
    CleanFileName = strFileName
    For lng_Index = 0 To UBound(arrInvalid)
        CleanFileName = Replace(CleanFileName, Chr(arrInvalid(lng_Index)), Chr(95))
    Next lng_Index
lbl_Exit:
    Exit Function
End Function

---