?
Solved

Outlook or excel macro to query data in excel and mail to each individual.

Posted on 2009-02-18
23
Medium Priority
?
278 Views
Last Modified: 2012-05-06
Hi,

Outlook or excel macro to query data in excel and mail to each individual.

Attached is a sample workbook sheet.

When the macro is run the data has to look as this      
      
To      santhosh
Subject      Blah blah blah
Body      Hi Santhosh,
      Blah blah blah
      1. Backlog-SGW
      2.Document Templates-SGW
      3.Products-SGW
Regards
Sharath

Each mail has to go to the colum A userand each cell data in colum B,C,D has to be in the body as points.
I will have 1 to many colums of data . Each may differ.

Regards
Sharath
Mailer.xls
0
Comment
Question by:bsharath
  • 13
  • 9
23 Comments
 
LVL 59

Expert Comment

by:Saurabh Singh Teotia
ID: 23671744
Hi Sharath,
How about trying some coding yourself..and coming back with the places in which you are struck at...here is a link to the site..which in details tells you how to send email from excel through vb macro...
http://www.rondebruin.nl/sendmail.htm
Saurabh...
0
 
LVL 50

Expert Comment

by:Dave Brett
ID: 23673023
Sharath,

try this. The code will display rather then send the message so hat you can control it
Cheers
Dave
 

Sub Mailem()
    Dim rng1 As Range, cel As Range
    Dim oApp, oMsg, oRecip, i As Long
    Dim tmpStr As String
    Set rng1 = Range([a1], Cells(Rows.Count, "A").End(xlUp))
    Set oApp = CreateObject("Outlook.Application")
    '  On Error Resume Next
    For Each cel In rng1
        If cel.Value <> vbNullString Then
            i = 0
            tmpStr = vbNullString
            Set oMsg = oApp.createitem(0)
            Do While cel.Offset(0, i + 1) <> vbNullString
                tmpStr = tmpStr & i + 1 & ". " & cel.Offset(0, i + 1).Value & vbNewLine
                i = i + 1
            Loop
            With oMsg
                .to = cel.Value
                .Subject = "blah blah blah"
                .body = "Hi " & cel.Value & "," & vbNewLine & tmpStr & "Regards," & vbNewLine & "Sharath"
                Set oRecip = .Recipients
                oRecip.resolveall
                .Display
            End With
            Set oMsg = Nothing
        End If
    Next
    Set oApp = Nothing
End Sub

Open in new window

0
 
LVL 11

Author Comment

by:bsharath
ID: 23673133
Thanks  a lot Dave works perfect

Colum A has names i need just the first name next to the "Hi"

Like my name is
Sharath tyu

In colum A i have as
Sharath
When the body gets created it has to get as
"Hi Sharath,"

Can i get few rows blank as below

To      santhosh
Subject      Blah blah blah
Body      Hi Santhosh,
      Blah blah blah (This line has to be in the body too)

      1. Backlog-SGW
      2.Document Templates-SGW
      3.Products-SGW

Regards
Sharath


0
Get your Disaster Recovery as a Service basics

Disaster Recovery as a Service is one go-to solution that revolutionizes DR planning. Implementing DRaaS could be an efficient process, easily accessible to non-DR experts. Learn about monitoring, testing, executing failovers and failbacks to ensure a "healthy" DR environment.

 
LVL 50

Expert Comment

by:Dave Brett
ID: 23673357
no probs. About to go out for dinner so I will get back for the tidy-ups in a few hours time :)
Cheers
Dave
0
 
LVL 11

Author Comment

by:bsharath
ID: 23673601
Ok

Can you tell me which line do i need to change to send mails rather than show up.

ike i can test a few after that i can send them directly.
if name failure can showup for my changes
As i need to send this to 2500 persons
0
 
LVL 50

Expert Comment

by:Dave Brett
ID: 23674571
Sharath,
This revised code will address the first name only (if  there is a space), add the "blah " to the body and the extra spaces
Change the
. Display
to
.Send
to send automatically
Cheers
Dave

Option Explicit
 
Sub Mailem()
    Dim rng1 As Range, cel As Range
    Dim oApp, oMsg, oRecip, i As Long
    Dim tmpStr As String
    Set rng1 = Range([a1], Cells(Rows.Count, "A").End(xlUp))
    Set oApp = CreateObject("Outlook.Application")
    '  On Error Resume Next
    For Each cel In rng1
        If cel.Value <> vbNullString Then
            i = 0
            tmpStr = vbNullString
            Set oMsg = oApp.createitem(0)
            Do While cel.Offset(0, i + 1) <> vbNullString
                tmpStr = tmpStr & i + 1 & ". " & cel.Offset(0, i + 1).Value & vbNewLine
                i = i + 1
            Loop
            With oMsg
                .to = cel.Value
                .Subject = "blah blah blah"
                .body = "Hi " & IIf(InStr(cel.Value, " "), Left$(cel.Value, InStr(cel.Value, " ") - 1), cel.Value) & "," & vbNewLine & vbNewLine & "blah blah blah2" & vbNewLine & tmpStr & vbNewLine & "Regards," & vbNewLine & "Sharath"
                Set oRecip = .Recipients
                oRecip.resolveall
                .Display
            End With
            Set oMsg = Nothing
        End If
    Next
    Set oApp = Nothing
End Sub

Open in new window

0
 
LVL 11

Author Comment

by:bsharath
ID: 23677529
Dave thanks after i could get 90 mails i get this error as attached
When debug goes here

.body = "Hi " & IIf(InStr(cel.Value, " "), Left$(cel.Value, InStr(cel.Value, " ") - 1), cel.Value) & "," & vbNewLine & vbNewLine & "blah blah blah2" & vbNewLine & tmpStr & vbNewLine & "Regards," & vbNewLine & "Sharath"

I tried the send command in another set and i get this.
There can be times when the user does not have a mail id. In such cases can it proceed by just keeping the unresolved email id on the display. So i could verify and send them later
I get another error as attached
When debug goes here
.Send

Can i get the name start letter in Caps
Like
Hi Sharath,
at present i get as
Hi sharath
0
 
LVL 11

Author Comment

by:bsharath
ID: 23677530
Dave thanks after i could get 90 mails i get this error as attached
When debug goes here

.body = "Hi " & IIf(InStr(cel.Value, " "), Left$(cel.Value, InStr(cel.Value, " ") - 1), cel.Value) & "," & vbNewLine & vbNewLine & "blah blah blah2" & vbNewLine & tmpStr & vbNewLine & "Regards," & vbNewLine & "Sharath"

I tried the send command in another set and i get this.
There can be times when the user does not have a mail id. In such cases can it proceed by just keeping the unresolved email id on the display. So i could verify and send them later
I get another error as attached
When debug goes here
.Send

Can i get the name start letter in Caps
Like
Hi Sharath,
at present i get as
Hi sharath

Capture.JPG
Capture1.JPG
0
 
LVL 50

Expert Comment

by:Dave Brett
ID: 23683000
hth
Cheers
Dave

Option Explicit
 
Sub Mailem()
    Dim rng1 As Range, cel As Range
    Dim oApp, oMsg, oRecip, i As Long
    Dim tmpStr As String
    Set rng1 = Range([a1], Cells(Rows.Count, "A").End(xlUp))
    Set oApp = CreateObject("Outlook.Application")
    On Error Resume Next
    For Each cel In rng1
        If cel.Value <> vbNullString Then
            i = 0
            tmpStr = vbNullString
            Set oMsg = oApp.createitem(0)
            Do While cel.Offset(0, i + 1) <> vbNullString
                tmpStr = tmpStr & i + 1 & ". " & cel.Offset(0, i + 1).Value & vbNewLine
                i = i + 1
            Loop
 
            With oMsg
                .to = cel.Value
                .Subject = "blah blah blah"
                .body = "Hi " & Application.WorksheetFunction.Proper(IIf(InStr(cel.Value, " "), Left$(cel.Value, InStr(cel.Value, " ") - 1), cel.Value)) & "," & vbNewLine & vbNewLine & "blah blah blah2" & vbNewLine & tmpStr & vbNewLine & "Regards," & vbNewLine & "Sharath"
                Set oRecip = .Recipients
                oRecip.resolveall
                If oRecip.resolveall Then
                    .send
                Else
                    .Display
                End If
            End With
            Set oMsg = Nothing
        End If
    Next
    Set oApp = Nothing
End Sub

Open in new window

0
 
LVL 11

Author Comment

by:bsharath
ID: 23683665
Dave i get no error but nothing in the body of the mail is sent. The subject is right. The body of all mails are empty
0
 
LVL 11

Author Comment

by:bsharath
ID: 23683666
Dave i get no error but nothing in the body of the mail is sent. The subject is right. The body of all mails are empty
0
 
LVL 50

Expert Comment

by:Dave Brett
ID: 23683864
Sharath,
Thi is strange as thecode is the same as before, other than capitaliation of the adresses's name, and a message display if the recipients are not resolved
Are you running it on a file with data in columns B, C etc? If there is a blank cell in coumn B then there will be no body
Pls take out this line
On Error Resume Next

and let me know what (if any)  error message you have
Cheers
Dave
 
0
 
LVL 11

Author Comment

by:bsharath
ID: 23684050
Dave i get  run time error 5
When debug goes here
.body = "Hi " & Application.WorksheetFunction.Proper(IIf(InStr(cel.Value, " "), Left$(cel.Value, InStr(cel.Value, " ") - 1), cel.Value)) & "," & vbNewLine & vbNewLine & "blah blah blah2" & vbNewLine & tmpStr & vbNewLine & "Regards," & vbNewLine & "Sharath"
0
 
LVL 11

Author Comment

by:bsharath
ID: 23684052
Dave i get  run time error 5
When debug goes here
.body = "Hi " & Application.WorksheetFunction.Proper(IIf(InStr(cel.Value, " "), Left$(cel.Value, InStr(cel.Value, " ") - 1), cel.Value)) & "," & vbNewLine & vbNewLine & "blah blah blah2" & vbNewLine & tmpStr & vbNewLine & "Regards," & vbNewLine & "Sharath"
0
 
LVL 50

Expert Comment

by:Dave Brett
ID: 23684409
the code  works fine for me on your sample file (attached)
Cheers
Dave

Copy-of-Mailer-1-.xls
0
 
LVL 11

Author Comment

by:bsharath
ID: 23684494
Dave still have the same issue.
the code here works perfect except the other options needs to be added.
ID: 23673023

I tried in a different machine and a new excel also get the same error in the same line
0
 
LVL 11

Author Comment

by:bsharath
ID: 23684495
Dave still have the same issue.
the code here works perfect except the other options needs to be added.
ID: 23673023

I tried in a different machine and a new excel also get the same error in the same line
0
 
LVL 50

Expert Comment

by:Dave Brett
ID: 23684580
Sharath,
Can you post a copy of the data that is failing?
Cheers
Dave
0
 
LVL 11

Author Comment

by:bsharath
ID: 23684753
Here is the data
Sharath      Intermediate (Read Only Permissions)      LE (Read Only Permissions)      LE3 (Read Only Permissions)      i.EPR 2.0 (Read & Write Permissions)      Document Templates (Read & Write Permissions)      

The above is the data that i have in the excel.

No errors mail is sent. With the subject right. Just the data above in colum B,C,D,E in the above case fails. The body is empty.


below is the code i am using. i even tried the code in the attached mail you sent. the same issue
Option Explicit
 
Sub Mailem()
    Dim rng1 As Range, cel As Range
    Dim oApp, oMsg, oRecip, i As Long
    Dim tmpStr As String
    Set rng1 = Range([a1], Cells(Rows.Count, "A").End(xlUp))
    Set oApp = CreateObject("Outlook.Application")
    On Error Resume Next
    For Each cel In rng1
        If cel.Value <> vbNullString Then
            i = 0
            tmpStr = vbNullString
            Set oMsg = oApp.createitem(0)
            Do While cel.Offset(0, i + 1) <> vbNullString
                tmpStr = tmpStr & i + 1 & ". " & cel.Offset(0, i + 1).Value & vbNewLine
                i = i + 1
            Loop
 
            With oMsg
                .to = cel.Value
                .Subject = "blah blah blah"
                .body = "Hi " & Application.WorksheetFunction.Proper(IIf(InStr(cel.Value, " "), Left$(cel.Value, InStr(cel.Value, " ") - 1), cel.Value)) & "," & vbNewLine & vbNewLine & "blah blah blah2" & vbNewLine & tmpStr & vbNewLine & "Regards," & vbNewLine & "Sharath"
                Set oRecip = .Recipients
                oRecip.resolveall
                If oRecip.resolveall Then
                    .send
                Else
                    .Display
                End If
            End With
            Set oMsg = Nothing
        End If
    Next
    Set oApp = Nothing
End Sub

Open in new window

0
 
LVL 11

Author Comment

by:bsharath
ID: 23684754
Here is the data
Sharath      Intermediate (Read Only Permissions)      LE (Read Only Permissions)      LE3 (Read Only Permissions)      i.EPR 2.0 (Read & Write Permissions)      Document Templates (Read & Write Permissions)      

The above is the data that i have in the excel.

No errors mail is sent. With the subject right. Just the data above in colum B,C,D,E in the above case fails. The body is empty.


below is the code i am using. i even tried the code in the attached mail you sent. the same issue
Option Explicit
 
Sub Mailem()
    Dim rng1 As Range, cel As Range
    Dim oApp, oMsg, oRecip, i As Long
    Dim tmpStr As String
    Set rng1 = Range([a1], Cells(Rows.Count, "A").End(xlUp))
    Set oApp = CreateObject("Outlook.Application")
    On Error Resume Next
    For Each cel In rng1
        If cel.Value <> vbNullString Then
            i = 0
            tmpStr = vbNullString
            Set oMsg = oApp.createitem(0)
            Do While cel.Offset(0, i + 1) <> vbNullString
                tmpStr = tmpStr & i + 1 & ". " & cel.Offset(0, i + 1).Value & vbNewLine
                i = i + 1
            Loop
 
            With oMsg
                .to = cel.Value
                .Subject = "blah blah blah"
                .body = "Hi " & Application.WorksheetFunction.Proper(IIf(InStr(cel.Value, " "), Left$(cel.Value, InStr(cel.Value, " ") - 1), cel.Value)) & "," & vbNewLine & vbNewLine & "blah blah blah2" & vbNewLine & tmpStr & vbNewLine & "Regards," & vbNewLine & "Sharath"
                Set oRecip = .Recipients
                oRecip.resolveall
                If oRecip.resolveall Then
                    .send
                Else
                    .Display
                End If
            End With
            Set oMsg = Nothing
        End If
    Next
    Set oApp = Nothing
End Sub

Open in new window

0
 
LVL 50

Accepted Solution

by:
Dave Brett earned 2000 total points
ID: 23685016
I've broken out the IIF - does this help?
Cheers
Dave

Option Explicit
 
 
Sub Mailem()
    Dim rng1 As Range, cel As Range
    Dim oApp, oMsg, oRecip, i As Long
    Dim tmpStr As String, newStr As String
    Set rng1 = Range([a1], Cells(Rows.Count, "A").End(xlUp))
    Set oApp = CreateObject("Outlook.Application")
    On Error Resume Next
    For Each cel In rng1
        If cel.Value <> vbNullString Then
            i = 0
            tmpStr = vbNullString
            Set oMsg = oApp.createitem(0)
            Do While cel.Offset(0, i + 1) <> vbNullString
                tmpStr = tmpStr & i + 1 & ". " & cel.Offset(0, i + 1).Value & vbNewLine
                i = i + 1
            Loop
 
            With oMsg
                .to = cel.Value
                .Subject = "blah blah blah"
                If InStr(cel.Value, " ") > 0 Then
                    newStr = Left$(cel.Value, InStr(cel.Value, " ") - 1)
                Else
                    newStr = cel.Value
                End If
                .body = "Hi " & Application.WorksheetFunction.Proper(newStr) & "," & vbNewLine & vbNewLine & "blah blah blah2" & vbNewLine & tmpStr & vbNewLine & "Regards," & vbNewLine & "Sharath"
                Set oRecip = .Recipients
                oRecip.resolveall
                If oRecip.resolveall Then
                    .send
                Else
                    .Display
                End If
            End With
            Set oMsg = Nothing
        End If
    Next
    Set oApp = Nothing
End Sub

Open in new window

0
 
LVL 11

Author Comment

by:bsharath
ID: 23688576
Thanks a lot Dave worked perfect
0
 
LVL 50

Expert Comment

by:Dave Brett
ID: 23693368
thx for the grade Sharath :)
0

Featured Post

Transaction-level recovery for Oracle database

Veeam Explore for Oracle delivers low RTOs and RPOs with agentless transaction log backup and transaction-level recovery of Oracle databases. You can restore the database to a precise point in time, even to a specific transaction.

Question has a verified solution.

If you are experiencing a similar issue, please ask a related question

Microsoft Office Picture Manager was included in Office 2003, 2007, and 2010, but not in Office 2013. Users had hopes that it would be in Office 2016/Office 365, but it is not. Fortunately, the same zero-cost technique that works to install it with …
In a use case, a user needs to close an opened report by simply pressing the Escape (Esc) key. This can be done by adding macro code in Report_KeyPress or Report_KeyDown event.
Polish reports in Access so they look terrific. Take yourself to another level. Equations, Back Color, Alternate Back Color. Write easy VBA Code. Tighten space to use less pages. Launch report from a menu, considering criteria only when it is filled…
Is your OST file inaccessible, Need to transfer OST file from one computer to another? Want to convert OST file to PST? If the answer to any of the above question is yes, then look no further. With the help of Stellar OST to PST Converter, you can e…
Suggested Courses

839 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question