email from excel using vba using the email address from an excel sheet 1

[diehippy]

Hi all,

I have looked everywhere for some vba code to email from excel picking up the email address from an excel work sheet can any one help, I would be most grateful

Many Thanks

 

[SkipVought]

Hi,

To eMail WHAT from Excel?

Skip,
[sub]
Just traded in my old subtlety...
for a NUANCE![/sub]

 

[diehippy]

Hi,

To email a excel file and use the email address from a different excel workbook also take a word document and paste it into the body of the email, here is the code I have so far

' email the new workbook
ESubject = "This is a test email"
Email = Windows("full_data_learner_check.xlsm").ActivateSheets("courselist").SelectName = Selection.ValueActiveCell.Offset(0, 2).Range("A1").Select
'CCTo = "to the clerk?"
Ebody = "Please check the data, save it and return to your clerk."
NewFileName = "N:\report_test3.xlsx"

Set App = CreateObject("Outlook.Application")
Set Itm = App.CreateItem(0)
With Itm
.Subject = ESubject
.To = SendTo
'.CC = CCTo
.Body = Ebody
.Attachments.Add (NewFileName) ' Must be complete path
'.Display ' This property is used when you want
' the user to see email and manually send.
.send

End With
Set App = Nothing
Set Itm = Nothing

I keep getting an error on line 2 which makes no sense to me. I think I need to use different function to make this work

Many Thanks

 

[SkipVought]

What is the Email variable???

       Email = Windows("full_data_learner_check.xlsm").ActivateSheets("courselist").SelectName = Selection.ValueActiveCell.Offset(0, 2).Range("A1").Select

You assign it.
It is not declared.
It is not used.

Before we address the syntax issues, need to know WHAT IS IT? And what is in the sheet that you're tyring to assign?

Please answer ALL these questions.

Skip,
[sub]
Just traded in my old subtlety...
for a NUANCE![/sub]

 

[diehippy]

Hi Skip,

The code that I sent you is just a macro made in excel to email a workbook. The code above you sent back is to lookup and the email address.

Do I declare it like this

'dim email as string'

Any Help you give is most appreciated

Many Thanks

Diehippy

 

[diehippy]

Hi Skip

I want to copy the cell reference above to the 'to' field on the email

Many Thanks

Mark

 

[diehippy]

Hi Skip

I have changed the code now I see where the I have not declared it

email the new workbook
ESubject = "This is a test email"
sendto = Windows("full_data_learner_check.xlsm").ActivateSheets("courselist").SelectName = Selection.ValueActiveCell.Offset(0, 2).Range("A1").Select
'CCTo = "to the clerk?"
Ebody = "Please check the data, save it and return to your clerk."
NewFileName = "N:\report_test3.xlsx"

Set App = CreateObject("Outlook.Application")
Set Itm = App.CreateItem(0)
With Itm
.Subject = ESubject
.To = SendTo
'.CC = CCTo
.Body = Ebody
.Attachments.Add (NewFileName) ' Must be complete path
'.Display ' This property is used when you want
' the user to see email and manually send.
.send

End With
Set App = Nothing
Set Itm = Nothing

I really don't understand why I am getting an error on line 2 - sendto = Windows("full_data_learner_check.xlsm").ActivateSheets("courselist").SelectName = Selection.ValueActiveCell.Offset(0, 2).Range("A1").Select

If you have time to help I would be most grateful

Many Thanks

Diehippy

 

[SkipVought]

The SendTo must be a delimited string, like you see in your To or CC box. I have a function that can produce such a string. The last two arguments are optional and can be assigned to remove the tic marks and separate with COLONs...

Function MakeList(rng As Range, Optional TK As String = "'", Optional CM As String = ",") As String
'SkipVought/2005 Jun 13/
'--------------------------------------------------
' Access: N/A
'--------------------------------------------------
':this function returns a single-quoted list that can be used, for instance _
in an IN Clause in SQL _
"WHERE PART_ID IN (" & MakeList([SomeRange]) & ")"
'--------------------------------------------------
    Dim r As Range
    
    For Each r In rng
        With r
            MakeList = MakeList & TK & Trim(.Value) & TK & CM
        End With
    Next
    MakeList = Left(MakeList, Len(MakeList) - 1)
End Function

Skip,
[sub]
Just traded in my old subtlety...
for a NUANCE![/sub]

 

[diehippy]

Hi Skip,

Thank you very much for the function. I just have a question.

If the cell in which I am trying to pick up the email from had quotes around the email address would the code work??

Many Thanks for your time and effort in helping me with this

Diehippy

 

[SkipVought]

I do not believe that you want quotes or tic around your email, unless that's what you see when you enter an address manually. THAT is what the string sould look like.

I was assuming, maybe in error, that you have a RANGE of email addresses. If you have an email LIST, you'll need SOMETHING that converts a range to a string. That's what my function does.

If you have JUST ONE in one cell, no need for the function.

Skip,
[sub]
Just traded in my old subtlety...
for a NUANCE![/sub]

 

[diehippy]

Hi Skip,

Thanks I should have explain that better each email address is in one cell

So I still don't understand why I keep getting this error when the code is correct

sendto = Windows("full_data_learner_check.xlsm").ActivateSheets("courselist").SelectActiveCell.Offset(0, 2).Range("A1").Select

Many Thanks for your continuing help with this problem

 

[SkipVought]

Something like this, that would reference cell C1.

I actively avoid using active cell, active sheet in almost all cases...

sendto = Workbooks("full_data_learner_check").Sheets("courselist").Range("A1").Offset(0, 2)

Skip,
[sub]
Just traded in my old subtlety...
for a NUANCE![/sub]

 

[diehippy]

Hi Skip,

That is Brillant, thank you for the code, if I was to add a loop into the mix. could I write a number into your code that would increase with each loop so that I could pick up a list of emails in excel starting at E3 to E1442

Many Thanks

Mark

 

[SkipVought]

sendto = MakeList(Workbooks("full_data_learner_check").Sheets("courselist").Range("E3:E1442"))

Skip,
[sub]
Just traded in my old subtlety...
for a NUANCE![/sub]

 

[diehippy]

Hi Skip,

Thanks again for all of your help. But I am still struggling to get this code to work, What I would like to do it take one email address set in e4 cell and email out a workbook then I would like to move down to the next cell where there is another address and email out a different file

Many Thanks in advance for any help that you can give me

Diehippy

 

[SkipVought]

dim r as range

for each r in range(Cells(4, "E"),Cells(4, "E").end(xldown))
  'send to r.value
'''''
next

Skip,
[sub]
Just traded in my old subtlety...
for a NUANCE![/sub]

 

[diehippy]

Hi Skip,

Thanks for the code, but I still keep getting an error on the sendto = r line object variable is not set

Any Ideas,

Many Thanks

Diehippy

 

[diehippy]

Hi Skip,

Sorry I worked through the last error I am now getting a new error on the

.To = sendto line

run time error -2147467259
array lower bound must be zero, I have tried looking into this and there is nto much out there. If you have any ideas I would be most grateful

Many Thanks

Diehippy

 

[SkipVought]

Please post ALL relevent code. Your code segment is meaningless!

Skip,
[sub]
Just traded in my old subtlety...
for a NUANCE![/sub]

 

[diehippy]

Hi Skip

I know what the problem is, I haven't explained it properly. Sorry for the confusion. What I need to do is

1. create an excel file that is fully formated from two sheets of data reference by a third

2 save the excel file using a cell reference as the filename from the third sheet

3. attach this newly created file to outlook template and then emailing this using data from the third sheet

4. I want to do this sequence for each row on the third sheet in a loop so I will create 1442 files that will be distrubuted to addresses on the third sheet

Here is the code I have so far, any ideas that could help me will be gratfully recieved

Sub create_report()
'
' create_report Macro
'

Dim r As Range
Set r = Range(Cells(4, "E"), Cells(4, "E".end(uldown))
'send to r.value
'''''
'Next



Application.ScreenUpdating = False
Sheets("Sheet1").Select
Range("A5:H5").Select
Selection.ClearContents
Range("A8:O8").Select
Selection.ClearContents
Range("A19:O33").Select
Selection.ClearContents
ActiveWindow.SmallScroll Down:=-24

'select name to use for filter
Sheets("courselist").Select
Name = Selection.Value
'ActiveCell.Offset(1, 0).Range("C4").Select

Selection.Copy

Sheets("parentchild ").Select
ActiveSheet.Range("$A$4:$M$1443").AutoFilter Field:=9, Criteria1:="=" & Name & "", _
Operator:=xlAnd
Cells.Select
Application.CutCopyMode = False
Selection.Copy
Sheets("Sheet1").Select
Range("A21").Select
ActiveSheet.Paste
Range("A23").Select
Application.CutCopyMode = False
Selection.Cut Destination:=Range("A5")
Range("B23").Select
Selection.Cut Destination:=Range("A8")
Range("C23").Select
Selection.Cut Destination:=Range("C5")
Range("D23").Select
Selection.Cut Destination:=Range("C8")
Range("E23").Select
Selection.Cut Destination:=Range("G5")
Range("F23").Select
Selection.Cut Destination:=Range("H8")
Range("G23").Select
Selection.Cut Destination:=Range("K8")
Range("H23").Select
Selection.Cut Destination:=Range("N8")
Range("I23").Select
Selection.Cut Destination:=Range("A15")
Range("J23").Select
Selection.Cut Destination:=Range("C15")
Range("K23").Select
Selection.Cut Destination:=Range("F15")
Range("L23").Select
Selection.Cut Destination:=Range("H15")
Range("M23").Select
Selection.Cut Destination:=Range("J15")
Rows("21:21").Select
Selection.ClearContents
Range("A210").Select
With Selection.Interior
.PatternColorIndex = xlAutomatic
.ThemeColor = xlThemeColorDark1
.TintAndShade = -4.99893185216834E-02
.PatternTintAndShade = 0
End With
Range("A1417").Select
With Selection.Interior
.PatternColorIndex = xlAutomatic
.ThemeColor = xlThemeColorAccent6
.TintAndShade = 0.799981688894314
.PatternTintAndShade = 0
End With
Range("A15:J15").Select
Selection.Font.Bold = True
With Selection.Font
.Size = 14
.Strikethrough = False
.Superscript = False
.Subscript = False
.OutlineFont = False
.Shadow = False
.Underline = xlUnderlineStyleNone
.ThemeColor = xlThemeColorLight1
.TintAndShade = 0
End With
Columns("H:H").ColumnWidth = 15.86
Range("C22").Select
'Sheets("learners").Select

'filter according to name variable
Sheets("learners").Select
ActiveSheet.Range("$V$5:$AJ$19152").AutoFilter Field:=1, Criteria1:="=" & Name & "", _
Operator:=xlAnd
Cells.Select
Application.CutCopyMode = False
Selection.Copy
Sheets("Sheet1").Select
Range("A19").Select
ActiveSheet.Paste
Rows("19:19").Select
Selection.Delete Shift:=xlUp
Columns("D").ColumnWidth = 10.57
Columns("E:E").ColumnWidth = 10.57
ActiveWindow.ScrollColumn = 2
ActiveWindow.ScrollColumn = 3
ActiveWindow.ScrollColumn = 2
ActiveWindow.ScrollColumn = 1
Cells.Select
Application.CutCopyMode = False
Selection.Copy
Workbooks.Add
Cells.Select
Selection.PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=False
Sheets("Sheet2").Select
Application.CutCopyMode = False
ActiveWindow.SelectedSheets.Delete
Sheets("Sheet3").Select
ActiveWindow.SelectedSheets.Delete
ActiveWorkbook.SaveAs Filename:="N:\report_test.xlsx", FileFormat:= _
xlOpenXMLWorkbook, CreateBackup:=False

' email the new workbook

ESubject = "This is a test email"
sendto = r.Value
'CCTo = "to the clerk?"
Ebody = "N:\Learner Check 2009 .oft"
NewFileName = "N:\report_test.xlsx"

Set App = CreateObject("Outlook.Application")
Set Itm = App.CreateItem(0)
With Itm
.Subject = ESubject
.To = sendto
'.CC = CCTo
.Body = Ebody
.Attachments.Add (NewFileName) ' Must be complete path
'.Display ' This property is used when you want
'the user to see email and manually send.
.Send

End With
Set App = Nothing
Set Itm = Nothing
'.send



'close the workbook and go back to master
Windows("report_test1.xlsx").Activate
ActiveWindow.Close

'go back to sheet2 and move onto next cell
Windows("full_data_learner_check.xlsm").Activate
Sheets("courselist").Select
ActiveCell.Offset(1, 0).Range("A1").Select


End Sub

P.S I am sorry I have been asked to do this by my boss who thinks you can do all of this with macros, I know you can not. I am currently learning oracle and this is the first time I have ever had to do anything like this in VBA

Many Thanks

Diehippy