Find a cell value in excel using outlook vba

[shas1928]

Dear All,

Greetings,

I would like to know is there any way to find a cell value ( which is an email address) from an excel file corresponding to my email subject or an input value ( which is employee ID) using outlook vba so that whenever creating an email, I can avoid searching for the specific recipient email address each time in the excel sheet which contains two columns (employee ID and email addresses).

Thanks for help & support.

regards
shas

 

[shas1928]

Dear All,

I am little disappointed since I haven't got a reply so far ( hope my question is not a senseless). but it made me keep digging.
so I found a solution and happy to share it in case it may helps someone like me.
here is the code and have a nice day.

Sub copyEmailFromExcel()
On Error GoTo ErrorHandler

Dim empEmail As String
Dim emailTo As Outlook.Recipient

Dim xlApp As Object
Dim sourceWB As Workbook
Dim sourceWS As Worksheet
Set xlApp = CreateObject("Excel.Application")
With xlApp
.Visible = False
.EnableEvents = False
End With
strFile = "C:\Users\.........\Desktop\staffemails.xlsx" 'Put your file path.
Set sourceWB = Workbooks.Open(strFile, , False, , , , , , , True)

Dim SearchRange As Range
Dim employeeID As Long
Dim lngLastRow As Long
Dim strRowNoList As String

employeeID = InputBox("Please Enter Employee ID") 'Value to search for, change as required.
lngLastRow = Cells(Rows.Count, "A").End(xlUp).Row 'Search Column A, change as required.
For Each Cell In Range("A2:A" & lngLastRow) 'Starting cell is A2, change as required.

If Cell.Value = employeeID Then 'check the value matches
strRowNoList = strRowNoList & Cell.Row
End If
Exit For
Next Cell

If strRowNoList = "" Then
MsgBox ("No emails found")
Exit Sub
End If
empEmail = Cells(strRowNoList, 2)
sourceWB.Close False

Dim objMsg As MailItem
Set objMsg = Application.ActiveInspector.CurrentItem
Set emailTo = objMsg.Recipients.Add(empEmail)
emailTo.Type = olTo
emailTo.Resolve
objMsg.Display


Exit Sub
ErrorHandler:
' Insert code to handle the error here
MsgBox ("Invalid ID or Unknown Error")
End Sub