Excel 10 how to send individual rows by email

danahoffman

New Member
Joined
Mar 15, 2014
Messages
24
G'Day to the List
1, Have Excel 2010 Spreadsheet with 300+ Rows of data each row is for a different individual with different email addresses.columns C-J in the body of email.
3. Have looked at VBA Macro code from every Excel site I can find, and have not found anything which will include columns C-J in bode of email now as attachment.
4. This is my first experience with VBA Macros with is probably 50% of problem.

dana hoffman
Colorado Emergency Prepared partnership
Denver, Colorado
303-863-9600
 
Hey, you mean D:J or you said C:J in previous mails.............your code as below, let me know how it goes.

Credits: Rondebruin

Sub Send_Row_Or_Rows_Attachment_2()

Dim OutApp As Object
Dim OutMail As Object
Dim rng As Range
Dim Ash As Worksheet
Dim Cws As Worksheet
Dim Rcount As Long
Dim Rnum As Long
Dim FilterRange As Range
Dim FieldNum As Integer
Dim NewWB As Workbook
Dim TempFilePath As String
Dim TempFileName As String
Dim FileExtStr As String
Dim FileFormatNum As Long
On Error GoTo cleanup
Set OutApp = CreateObject("Outlook.Application")
With Application
.EnableEvents = False
.ScreenUpdating = False
End With
'Set filter sheet, you can also use Sheets("MySheet")
Set Ash = ActiveSheet
'Set filter range and filter column (column with e-mail addresses)
Set FilterRange = Ash.Range("A1:J" & Ash.Rows.Count)
FieldNum = 2 'Filter column = B because the filter range start in column A
'Add a worksheet for the unique list and copy the unique list in A1
Set Cws = Worksheets.Add
FilterRange.Columns(FieldNum).AdvancedFilter _
Action:=xlFilterCopy, _
CopyToRange:=Cws.Range("A1"), _
CriteriaRange:="", Unique:=True
'Count of the unique values + the header cell
Rcount = Application.WorksheetFunction.CountA(Cws.Columns(1))
'If there are unique values start the loop
If Rcount >= 2 Then
For Rnum = 2 To Rcount
'If the unique value is a mail addres create a mail
If Cws.Cells(Rnum, 1).Value Like "?*@?*.?*" Then
'Filter the FilterRange on the FieldNum column
FilterRange.AutoFilter Field:=FieldNum, _
Criteria1:=Cws.Cells(Rnum, 1).Value
'Copy the visible data in a new workbook
With Ash.AutoFilter.Range
On Error Resume Next
Set rng = .SpecialCells(xlCellTypeVisible)
On Error GoTo 0
End With
Set NewWB = Workbooks.Add(xlWBATWorksheet)
rng.Copy
With NewWB.Sheets(1)
.Cells(1).PasteSpecial Paste:=8
.Cells(1).PasteSpecial Paste:=xlPasteValues
.Cells(1).PasteSpecial Paste:=xlPasteFormats
.Columns("A:C").Delete
.Cells(1, 1).Select
Application.CutCopyMode = False
End With
'Create a file name
TempFilePath = Environ$("temp") & "\"
TempFileName = "Output " & Ash.Parent.Name _
& " " & Format(Now, "dd-mmm-yy h-mm-ss")
If Val(Application.Version) < 12 Then
'You use Excel 97-2003
FileExtStr = ".xls": FileFormatNum = -4143
Else
'You use Excel 2007-2013
FileExtStr = ".xlsx": FileFormatNum = 51
End If
'Save, Mail, Close and Delete the file
Set OutMail = OutApp.CreateItem(0)
With NewWB
.SaveAs TempFilePath & TempFileName _
& FileExtStr, FileFormat:=FileFormatNum
On Error Resume Next
With OutMail
.To = Cws.Cells(Rnum, 1).Value
.Subject = "Test mail"
.Attachments.Add NewWB.FullName
.Body = "Hi there"
.Display 'Or use Send
End With
On Error GoTo 0
.Close savechanges:=False
End With
Set OutMail = Nothing
Kill TempFilePath & TempFileName & FileExtStr
End If
'Close AutoFilter
Ash.AutoFilterMode = False
Next Rnum
End If
cleanup:
Set OutApp = Nothing
Application.DisplayAlerts = False
Cws.Delete
Application.DisplayAlerts = True
With Application
.EnableEvents = True
.ScreenUpdating = True
End With

End Sub
 
Upvote 0
Error message at : "On Error GoTo cleanup" Compile Error, Invalid Outside procedure"

Looks like your making good progress, could this code be result of settings?
dana
 
Upvote 0
This ran fine on Windows 8, Office 2013...........................on my side. see to it that other macros do not have the same sub_name............and did you try pasting data............do one thing, copy-paste my above code, onto your file............check once more, if errors persist, send me the same file.

Its weird !!! hopefully not as weird as MH 370 !
 
Upvote 0
Certainly not as weird as MH 370. (I'm a former investigator with several major airline crashes investigated last was Continental 1713.

1. Was able to run code and three separate emails displayed.
Then I changed Display to run and three separate emails were sent.

If I may come back to the Well one more time, can you help modify the code for the information from Tabs prints in the body of the email after the Message. TO Line should read: " CEPP Member, please verify and reply with confirmation or changes on below Emergency Contact Information" dana.hoffman@cepp.org.

Body of Email should have this statement: CEPP is evaluating a new Emergency Warning system which may send text messages t cell phones and additionally send voice information to work, or home phones. Please verify your information or reply to dana.hoffman@thecepp,org with changes. Your cooperation is appreciated. Dana Hoffman, CEPP Communications Chair.

Congratulations, it even works with the longer subject and body information. NOW IF YOU COULD HELP Include the data in body of email, this will be PERFECT>!!!!
dana
 
Upvote 0
Can we show all the fields in range from the spreadsheet? Just realized that members may have changed names (marriage) otr changed email addresses as well as phone numbers. Is it possible to send all column on each line in the body of the email, or the body of the attachment if we have to go with attachment.

Thanks to all for your patience and knowledge.
dana hoffman
 
Upvote 0
TO Line should read: " CEPP Member, please verify and reply with confirmation or changes on below Emergency Contact Information" dana.hoffman@cepp.org.

Insert this line to the ".Subject" line, insert your line instead of "Hi there"

Insert your body text to ".Body" line of the code.

Your e-mail ID gave me your company's name as also the files you hosted for me on your company's servers told me you are an investigator/detective. In case you want to show all the columns delete the below line from the code.

.Columns("A:C").Delete

By the way, what did your investigation of Continental 1713 sum upto ?
 
Upvote 0

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