VBA code for outlook to find serial number from excel

R

RodrigoFinguer

Board Regular
Joined
Jun 13, 2017
Messages
75
Hi, I am really not good to work with outlook codes, so here I am.

I have a list of serial numbers in a random column, let's say column B. I need to copy the code, and need to find in email body or subject in outlook, returning the e-mail who sent me and what time was it.

I think that's not that complicated, appreciate all your help, thanks!
 

Excel Facts

Spell Check in Excel
Press F7 to start spell check in Excel. Be careful, by default, Excel does not check Capitalized Werds (whoops)
Sort by date Sort by votes
Create a sheet called Temp.
Change "CodeSheet" by the name of your sheet

Put your codes in column B, the results will be in columns C and D

Code: 
Private Sub CommandButton1_Click()
'
    Application.ScreenUpdating = False
    Application.StatusBar = False
    '
    '
    Dim olApp As Outlook.Application
    Dim objNS As Outlook.Namespace
    Dim olFolder As Outlook.MAPIFolder
    'Dim msg As Outlook.MailItem
    Dim msg As Object
    '
    Set olApp = Outlook.Application
    Set objNS = olApp.GetNamespace("MAPI")
    Set olFolder = objNS.GetDefaultFolder(olFolderInbox)
    '
    Set h1 = Sheets("CodeSheet")
    Set h2 = Sheets("Temp")
    i = 2
    h2.Cells.ClearContents
    '
    cuantos = olFolder.Items.Count
    On Error Resume Next
    For Each msg In olFolder.Items
        Application.StatusBar = "Processing : " & i & " of : " & cuantos
        h2.Cells(i, "A").Value = msg.SenderName
        h2.Cells(i, "B").Value = msg.Subject
        h2.Cells(i, "C").Value = msg.body
        h2.Cells(i, "D").Value = msg.ReceivedTime
        i = i + 1
    Next
    '
    For i = 2 To h1.Range("B" & Rows.Count).End(xlUp).Row
        Set b = h2.Columns("B:C").Find(h1.Cells(i, "B"), lookat:=xlPart, LookIn:=xlValues)
        If Not b Is Nothing Then
            h1.Cells(i, "C").Value = h2.Cells(b.Row, "A").Value
            h1.Cells(i, "D").Value = h2.Cells(b.Row, "D").Value
        End If
    Next
    Application.ScreenUpdating = True
    MsgBox "End"
End Sub
 
Upvote 0
DanteAmor said:
Create a sheet called Temp.
Change "CodeSheet" by the name of your sheet

Put your codes in column B, the results will be in columns C and D

Code: 
Private Sub CommandButton1_Click()
'
    Application.ScreenUpdating = False
    Application.StatusBar = False
    '
    '
    Dim olApp As Outlook.Application
    Dim objNS As Outlook.Namespace
    Dim olFolder As Outlook.MAPIFolder
    'Dim msg As Outlook.MailItem
    Dim msg As Object
    '
    Set olApp = Outlook.Application
    Set objNS = olApp.GetNamespace("MAPI")
    Set olFolder = objNS.GetDefaultFolder(olFolderInbox)
    '
    Set h1 = Sheets("CodeSheet")
    Set h2 = Sheets("Temp")
    i = 2
    h2.Cells.ClearContents
    '
    cuantos = olFolder.Items.Count
    On Error Resume Next
    For Each msg In olFolder.Items
        Application.StatusBar = "Processing : " & i & " of : " & cuantos
        h2.Cells(i, "A").Value = msg.SenderName
        h2.Cells(i, "B").Value = msg.Subject
        h2.Cells(i, "C").Value = msg.body
        h2.Cells(i, "D").Value = msg.ReceivedTime
        i = i + 1
    Next
    '
    For i = 2 To h1.Range("B" & Rows.Count).End(xlUp).Row
        Set b = h2.Columns("B:C").Find(h1.Cells(i, "B"), lookat:=xlPart, LookIn:=xlValues)
        If Not b Is Nothing Then
            h1.Cells(i, "C").Value = h2.Cells(b.Row, "A").Value
            h1.Cells(i, "D").Value = h2.Cells(b.Row, "D").Value
        End If
    Next
    Application.ScreenUpdating = True
    MsgBox "End"
End Sub
Click to expand...

It worked, but returns me every e-mail and i just want the e-mail containing the serial number. Also, the most recent e-mail the macro is returning me is from 15/01/2019, which is incorrect since I have e-mails from today.
 
Last edited:
Upvote 0
Sorry, now it worked (maybe i have done anything wrong). I will try with different serials, anything can i send you a message?

Just one more thing it's bothering me... the messages items counter it's 304, but i have a total of 2853 e-mails. What is this number of 304?

And there is a way to find the serial number if contains text? For example, a subject: "Number 455542 serial", find the "455542", even in the body text.
 
Last edited:
Upvote 0
RodrigoFinguer said:
Sorry, now it worked (maybe i have done anything wrong). I will try with different serials, anything can i send you a message?

Just one more thing it's bothering me... the messages items counter it's 304, but i have a total of 2853 e-mails. What is this number of 304?

And there is a way to find the serial number if contains text? For example, a subject: "Number 455542 serial", find the "455542", even in the body text.
Click to expand...

The macro is already looking at the body and the subject. You can see the data on the "Temp" sheet.
The number 304 corresponds to your emails in the Inbox, the number 2853 are your emails, but you have them in another folder?
Finally, the macro looks for the number "455542" within the entire text.
 
Upvote 0
DanteAmor said:
The macro is already looking at the body and the subject. You can see the data on the "Temp" sheet.
The number 304 corresponds to your emails in the Inbox, the number 2853 are your emails, but you have them in another folder?
Finally, the macro looks for the number "455542" within the entire text.
Click to expand...


Oh okay, thats correct then.
Do you know how can i get the date and the time separate? I tried to find but with no success
 
Upvote 0
RodrigoFinguer said:
Oh okay, thats correct then.
Do you know how can i get the date and the time separate? I tried to find but with no success
Click to expand...

Try with this

Code: 
Private Sub CommandButton1_Click()
'
    Application.ScreenUpdating = False
    Application.StatusBar = False
    '
    '
    Dim olApp As Outlook.Application
    Dim objNS As Outlook.Namespace
    Dim olFolder As Outlook.MAPIFolder
    'Dim msg As Outlook.MailItem
    Dim msg As Object
    '
    Set olApp = Outlook.Application
    Set objNS = olApp.GetNamespace("MAPI")
    Set olFolder = objNS.GetDefaultFolder(olFolderInbox)
    '
    Set h1 = Sheets("CodeSheet")
    Set h2 = Sheets("Temp")
    i = 2
    h2.Cells.ClearContents
    '
    cuantos = olFolder.Items.Count
    On Error Resume Next
    For Each msg In olFolder.Items
        Application.StatusBar = "Processing : " & i & " of : " & cuantos
        h2.Cells(i, "A").Value = msg.SenderName
        h2.Cells(i, "B").Value = msg.Subject
        h2.Cells(i, "C").Value = msg.body
        h2.Cells(i, "D").Value = msg.ReceivedTime
        i = i + 1
    Next
    '
    For i = 2 To h1.Range("B" & Rows.Count).End(xlUp).Row
        Set b = h2.Columns("B:C").Find(h1.Cells(i, "B"), lookat:=xlPart, LookIn:=xlValues)
        If Not b Is Nothing Then
            h1.Cells(i, "C").Value = h2.Cells(b.Row, "A").Value
            fecha = CDate(Format(h2.Cells(b.Row, "D").Value, "mm/dd/yyyy"))
            tiempo = Format(h2.Cells(b.Row, "D").Value, "hh:mm")
            h1.Cells(i, "D").Value = fecha
            h1.Cells(i, "E").Value = tiempo
        End If
    Next
    Application.ScreenUpdating = True
    Application.StatusBar = False
    MsgBox "End"
End Sub
 
Upvote 0
DanteAmor said:
Try with this

Code: 
Private Sub CommandButton1_Click()
'
    Application.ScreenUpdating = False
    Application.StatusBar = False
    '
    '
    Dim olApp As Outlook.Application
    Dim objNS As Outlook.Namespace
    Dim olFolder As Outlook.MAPIFolder
    'Dim msg As Outlook.MailItem
    Dim msg As Object
    '
    Set olApp = Outlook.Application
    Set objNS = olApp.GetNamespace("MAPI")
    Set olFolder = objNS.GetDefaultFolder(olFolderInbox)
    '
    Set h1 = Sheets("CodeSheet")
    Set h2 = Sheets("Temp")
    i = 2
    h2.Cells.ClearContents
    '
    cuantos = olFolder.Items.Count
    On Error Resume Next
    For Each msg In olFolder.Items
        Application.StatusBar = "Processing : " & i & " of : " & cuantos
        h2.Cells(i, "A").Value = msg.SenderName
        h2.Cells(i, "B").Value = msg.Subject
        h2.Cells(i, "C").Value = msg.body
        h2.Cells(i, "D").Value = msg.ReceivedTime
        i = i + 1
    Next
    '
    For i = 2 To h1.Range("B" & Rows.Count).End(xlUp).Row
        Set b = h2.Columns("B:C").Find(h1.Cells(i, "B"), lookat:=xlPart, LookIn:=xlValues)
        If Not b Is Nothing Then
            h1.Cells(i, "C").Value = h2.Cells(b.Row, "A").Value
            fecha = CDate(Format(h2.Cells(b.Row, "D").Value, "mm/dd/yyyy"))
            tiempo = Format(h2.Cells(b.Row, "D").Value, "hh:mm")
            h1.Cells(i, "D").Value = fecha
            h1.Cells(i, "E").Value = tiempo
        End If
    Next
    Application.ScreenUpdating = True
    Application.StatusBar = False
    MsgBox "End"
End Sub
Click to expand...

Worked! You are a genius! Thanks
 
Upvote 0
DanteAmor said:
Try with this

Code: 
Private Sub CommandButton1_Click()
'
    Application.ScreenUpdating = False
    Application.StatusBar = False
    '
    '
    Dim olApp As Outlook.Application
    Dim objNS As Outlook.Namespace
    Dim olFolder As Outlook.MAPIFolder
    'Dim msg As Outlook.MailItem
    Dim msg As Object
    '
    Set olApp = Outlook.Application
    Set objNS = olApp.GetNamespace("MAPI")
    Set olFolder = objNS.GetDefaultFolder(olFolderInbox)
    '
    Set h1 = Sheets("CodeSheet")
    Set h2 = Sheets("Temp")
    i = 2
    h2.Cells.ClearContents
    '
    cuantos = olFolder.Items.Count
    On Error Resume Next
    For Each msg In olFolder.Items
        Application.StatusBar = "Processing : " & i & " of : " & cuantos
        h2.Cells(i, "A").Value = msg.SenderName
        h2.Cells(i, "B").Value = msg.Subject
        h2.Cells(i, "C").Value = msg.body
        h2.Cells(i, "D").Value = msg.ReceivedTime
        i = i + 1
    Next
    '
    For i = 2 To h1.Range("B" & Rows.Count).End(xlUp).Row
        Set b = h2.Columns("B:C").Find(h1.Cells(i, "B"), lookat:=xlPart, LookIn:=xlValues)
        If Not b Is Nothing Then
            h1.Cells(i, "C").Value = h2.Cells(b.Row, "A").Value
            fecha = CDate(Format(h2.Cells(b.Row, "D").Value, "mm/dd/yyyy"))
            tiempo = Format(h2.Cells(b.Row, "D").Value, "hh:mm")
            h1.Cells(i, "D").Value = fecha
            h1.Cells(i, "E").Value = tiempo
        End If
    Next
    Application.ScreenUpdating = True
    Application.StatusBar = False
    MsgBox "End"
End Sub
Click to expand...

Sorry for this... but now i need a little different. Instead searching a code, I need the macro to select my subfolder called "Events", get the same information from e-mail, but this time I have not the serial, the macro will get the serial from the body, its located after the word "Event", example "Event Doc143445456", returning me just the second part. Also, it will get a name from the subject, after "-", example, "Event3 - NAME THAT I NEED".

Just try to help me, otherwise i will try myself, sorry bothering you!
 
Upvote 0
You must log in or register to reply here.

Similar threads

A
  • Question Question
Outlook File Attachment using VBA
2 3
Replies
22
Views
3K
RoryA
RoryA
spacecaptainsuperguy
  • Question Question
Simple VBA for Outlook - Copy last sent email
Replies
0
Views
540
spacecaptainsuperguy
spacecaptainsuperguy
E
  • Solved
VBA code to remove carriage returns from outlook table
Replies
3
Views
467
eranjo
E
R
  • Question Question
Mail merge to insert the picture in the mail body and schedule the email
Replies
0
Views
1K
rafeek4u
R
A
  • Question Question
Copying whole word document, into excel + formatting columns and cells
Replies
1
Views
270
Macropod
Macropod

Forum statistics

Threads
1,223,970
Messages
6,175,693
Members
452,667
Latest member
vanessavalentino83

Share this page

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top