OnerousOutlo
01-05-2023, 11:01 PM
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
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.Rest rict(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
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.Rest rict(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