How To Auto Copy Excel Cells To Outlook Email - Excel

I have to send daily emails to a group mail
the info on the email is in an excel sheet from 300 line  I need to send one line  daily
is there a way to automate this process?
hope someone can help me on that
ashrafelnahasAsked:
Who is Participating?

[Product update] Infrastructure Analysis Tool is now available with Business Accounts.Learn More

x
I wear a lot of hats...

"The solutions and answers provided on Experts Exchange have been extremely helpful to me over the last few years. I wear a lot of hats - Developer, Database Administrator, Help Desk, etc., so I know a lot of things but not a lot about one thing. Experts Exchange gives me answers from people who do know a lot about one thing, in a easy to use platform." -Todd S.

Thomas Zucker-ScharffSolution GuideCommented:
Yes. I can give you the vba script I use. On Monday.
0
ashrafelnahasAuthor Commented:
Many thanks waiting for your reply
0
Thomas Zucker-ScharffSolution GuideCommented:
0
Determine the Perfect Price for Your IT Services

Do you wonder if your IT business is truly profitable or if you should raise your prices? Learn how to calculate your overhead burden with our free interactive tool and use it to determine the right price for your IT services. Download your free eBook now!

Thomas Zucker-ScharffSolution GuideCommented:
This is the generic script I use.  note that the last few lines make it bypass the builtin security of outlook to autosend with out your interference.

I use a workbook that is set up for this.  The attached workboot is macro enabled and has a button in the "command to start" sheet that starts the macro.

Option Explicit
Public WasOpen As Boolean
Private Function FireOutlook() As Object
On Error Resume Next
Dim objOutlook As Object

Set objOutlook = GetObject(, "Outlook.Application")
'MsgBox Err.Number & " " & Err.Description
If Err.Number = 429 Then
    Err.Clear
    WasOpen = False
    ' Create the Outlook session.
    Set objOutlook = CreateObject("Outlook.Application")
Else
    WasOpen = True
End If
Set FireOutlook = objOutlook
End Function


Sub Send_Email()
Dim OutApp As Object
Dim OutMail As Object
Dim TheFile As String
Dim x As Integer
Dim StartRow As String
Dim EndRow As String
Dim WrkshtName As String
Dim GreetingName As Integer
Dim MessageBody As String
Dim SubjectText As String
Dim Signature As Integer
Dim Attachment1 As Integer
Dim Attachment2 As Integer
Dim FullPathToAttachment1 As Integer
Dim FullPathToAttachment2 As Integer
Dim CloseName As String
Dim CloseString As String
Dim MailSender As String
'Dim Wrksht As Worksheet
'Dim StartCell As String
'Dim Attachment2Inc As String

WrkshtName = InputBox("Please enter the Name of the worksheet that contains the data to be emailed:", "Name of worksheet", "Sheet1")
SubjectText = InputBox("Enter the subject line of the email", "Subject Line:", "Subject of Email")
CloseString = InputBox("Enter the close word(s) that will appear in the complimentary close of the message here:", "Complimentary closure", "Sincerely,")
CloseName = InputBox("Enter the name that will appear in the complimentary close of the message here:", "Name after Sincerely", "David")
'Attachment2Inc = InputBox("Do you have a second attachment", "Second Attachment?", "yes")

MsgBox ("Note that for the rest of the inputs you can use the defaults if you follow the excel template when entering information")

Set OutApp = FireOutlook()
OutApp.Session.Logon

' convert excel lettered column to number
Dim InputLetter As String
Dim OutputNumber As Integer
Dim Leng As Integer
Dim i As Integer

InputLetter = InputBox("Please enter the column of the worksheet - column letter - in which the Name you wish to use as a greeting appears:", "Greeting Name", "E")  ' Input the Column Letter
Leng = Len(InputLetter)
OutputNumber = 0


For i = 1 To Leng
   OutputNumber = (Asc(UCase(Mid(InputLetter, i, 1))) - 64) + OutputNumber * 26
Next i
' end convert subroutine
GreetingName = OutputNumber

' convert excel lettered column to number
Dim InputLetter2 As String
Dim OutputNumber2 As Integer
Dim Leng2 As Integer
Dim i2 As Integer

InputLetter2 = InputBox("Please enter the column of the worksheet - column letter - in which the Signature you wish to use appears:", "Signature Column", "M")  ' Input the Column Letter
Leng2 = Len(InputLetter2)
OutputNumber2 = 0


For i2 = 1 To Leng2
   OutputNumber2 = (Asc(UCase(Mid(InputLetter2, i2, 1))) - 64) + OutputNumber2 * 26
Next i2
' end convert subroutine
Signature = OutputNumber2

' convert excel lettered column to number
Dim InputLetter3 As String
Dim OutputNumber3 As Integer
Dim Leng3 As Integer
Dim i3 As Integer

InputLetter3 = InputBox("Please enter the column of the worksheet - column letter - in which the name of first attachment you wish to use is stored:", "First Attachment Column", "B")  ' Input the Column Letter
Leng3 = Len(InputLetter3)
OutputNumber3 = 0


For i3 = 1 To Leng3
   OutputNumber3 = (Asc(UCase(Mid(InputLetter3, i3, 1))) - 64) + OutputNumber3 * 26
Next i3
' end convert subroutine
Attachment1 = OutputNumber3

' convert excel lettered column to number
Dim InputLetter4 As String
Dim OutputNumber4 As Integer
Dim Leng4 As Integer
Dim i4 As Integer

InputLetter4 = InputBox("Please enter the column of the worksheet - column letter - in which the name of second attachment you wish to use is stored:", "Second Attachment Column", "G")  ' Input the Column Letter
Leng4 = Len(InputLetter4)
OutputNumber4 = 0


For i4 = 1 To Leng4
   OutputNumber4 = (Asc(UCase(Mid(InputLetter4, i4, 1))) - 64) + OutputNumber4 * 26
Next i4
' end convert subroutine
Attachment2 = OutputNumber4

' convert excel lettered column to number
Dim InputLetter6 As String
Dim OutputNumber6 As Integer
Dim Leng6 As Integer
Dim i6 As Integer

InputLetter6 = InputBox("Please enter the column of the worksheet - column letter - in which the path to the first attachment you wish to use is stored:", "First Attachment Path Column", "P")  ' Input the Column Letter
Leng6 = Len(InputLetter6)
OutputNumber6 = 0


For i6 = 1 To Leng6
   OutputNumber6 = (Asc(UCase(Mid(InputLetter6, i6, 1))) - 64) + OutputNumber6 * 26
Next i6
' end convert subroutine
FullPathToAttachment1 = OutputNumber6

' convert excel lettered column to number
Dim InputLetter5 As String
Dim OutputNumber5 As Integer
Dim Leng5 As Integer
Dim i5 As Integer

InputLetter5 = InputBox("Please enter the column of the worksheet - column letter - in which the path to the second attachment you wish to use is stored:", "Second Attachment Path Column", "O")  ' Input the Column Letter
Leng5 = Len(InputLetter5)
OutputNumber5 = 0


For i5 = 1 To Leng5
   OutputNumber5 = (Asc(UCase(Mid(InputLetter5, i5, 1))) - 64) + OutputNumber5 * 26
Next i5
'If Attachment2Inc = "yes" Then OutputNumber5 = ""

' end convert subroutine
FullPathToAttachment2 = OutputNumber5

StartRow = InputBox("Start at what row in the worksheet?", "Start", 10)
If StartRow = "" Or IsNumeric(StartRow) = False Then Exit Sub
EndRow = InputBox("End at what row in the worksheet?", "End", 10)
If EndRow = "" Or IsNumeric(EndRow) = False Then Exit Sub

'Set Wrksht = Sheets(WrkshtName)
'StartCell = "A" & StartRow
'Wrksht.Range (StartCell)

For x = CInt(StartRow) To CInt(EndRow)
    Set OutMail = OutApp.CreateItem(0)
    With OutMail
    '.To = "tzs@cyberdude.com" ' This code makes it work with windows 8 when uncommented (WrkshtName is not being processed correctly)
    .To = Worksheets(WrkshtName).Cells(x, 1) 'Row x, Column A
    .CC = ""
    .BCC = ""
    .Subject = SubjectText
    ' greeting using nick Name
    .HTMLBody = "Dear " & Worksheets(WrkshtName).Cells(x, GreetingName) & "," 'Row x, Column R
    .HTMLBody = .HTMLBody & Worksheets(WrkshtName).Cells(x, 9).Value 'Row x, Column I
    .HTMLBody = .HTMLBody & Worksheets(WrkshtName).Cells(x, 17).Value ' blank line using tr and td
    .HTMLBody = .HTMLBody & Worksheets(WrkshtName).Cells(x, 18).Value ' message body
    .HTMLBody = .HTMLBody & Worksheets(WrkshtName).Cells(x, 17).Value ' blank line again
    .HTMLBody = .HTMLBody & Worksheets(WrkshtName).Cells(x, 17).Value ' blank line again
    .HTMLBody = .HTMLBody & Worksheets(WrkshtName).Cells(x, 10).Value ' before closure
    .HTMLBody = .HTMLBody & CloseString ' sincerely yours,
    .HTMLBody = .HTMLBody & Worksheets(WrkshtName).Cells(x, 11).Value ' html before name
    .HTMLBody = .HTMLBody & CloseName ' name
    .HTMLBody = .HTMLBody & Worksheets(WrkshtName).Cells(x, 12).Value ' end of html of closure
    .HTMLBody = .HTMLBody & Worksheets(WrkshtName).Cells(x, 13).Value ' full signature
    .HTMLBody = .HTMLBody & Worksheets(WrkshtName).Cells(x, 14).Value ' end of html
    ' attach the previous years survey or a blank
    .Attachments.Add Worksheets(WrkshtName).Cells(x, Attachment1).Value 'Row x, Column B
    ' attach this years facility usage table or a blank
    .Attachments.Add Worksheets(WrkshtName).Cells(x, Attachment2).Value 'Row x, Column F
    ' The next 3 lines bypass outlook security to autosend emails without a product like ClickYes
    .display
    Application.Wait (Now + TimeValue("0:00:02"))
    Application.SendKeys "%s"
    '.Send
    End With
    Set OutMail = Nothing
Next x
 

Set OutApp = Nothing
 
 End Sub

Open in new window

0

Experts Exchange Solution brought to you by

Your issues matter to us.

Facing a tech roadblock? Get the help and guidance you need from experienced professionals who care. Ask your question anytime, anywhere, with no hassle.

Start your 7-day free trial
ashrafelnahasAuthor Commented:
can you send details setps
0
Thomas Zucker-ScharffSolution GuideCommented:
Yes. Contact me offline at t.zucker@gmail.com.
0
ashrafelnahasAuthor Commented:
how can I use VBA ion daily basis it needs to be on task scheduler
0
Martin LissOlder than dirtCommented:
This question has been classified as abandoned and is closed as part of the Cleanup Program. See the recommendation for more details.
0
It's more than this solution.Get answers and train to solve all your tech problems - anytime, anywhere.Try it for free Edge Out The Competitionfor your dream job with proven skills and certifications.Get started today Stand Outas the employee with proven skills.Start learning today for free Move Your Career Forwardwith certification training in the latest technologies.Start your trial today
Outlook

From novice to tech pro — start learning today.