Macro to Send Different Files to Differrent Emails

[shaker93]

Hello.

Please help me with this.
I am trying to create a macro in which i can send different files to different emails.
I was looking in this site and others and i came up with this code.

================================

Sub asddddddddddddd()

Dim OutApp As Object
Dim OutMail As Object
Dim cell As Range
Dim i As Integer



Application.ScreenUpdating = False


Set OutApp = CreateObject("Outlook.Application")
On Error GoTo cleanup
For Each cell In Columns("B").Cells.SpecialCells(xlCellTypeConstants)
If cell.Value Like "?*@?*.?*" Then
Set OutMail = OutApp.CreateItem(0)
On Error Resume Next
With OutMail
.To = cell.Value
.Subject = "Reminder"
.Body = "Dear " & Cells(cell.Row, "A").Value _
& vbNewLine & vbNewLine & _
"Please contact us to discuss bringing " & _
"your account up to date"
.Attachments.Add ThisWorkbook.Sheets("Sheet1").Range("C" & i)
.Send 'Or use Display.
End With
On Error GoTo 0
Set OutMail = Nothing
Set oMail = Nothing
Set oApp = Nothing
End If
Next cell

cleanup:
Set OutApp = Nothing
Application.ScreenUpdating = True
End Sub
==========================================

In column A I put the name of the person
B the emails
C the file path

The problem is that when i run the macro, no attachment is sent, but the rest of the message is.
I do not know why

Can you help me

 

[jproffer]

Re: Question

I might be missing it, but I don't see where you're defining the variable "i"

.Attachments.Add ThisWorkbook.Sheets("Sheet1").Range("C" & i)

If you are, and I did in fact miss it, then try adding ".Value" behind the range.

 

[Fluff]

Re: Question

I agree with jproffer, try

.Attachments.Add ThisWorkbook.Sheets("Sheet1").Range("C" & cell.row)

 

[shaker93]

Re: Question

I might be missing it, but I don't see where you're defining the variable "i"

.Attachments.Add ThisWorkbook.Sheets("Sheet1").Range("C" & i)

If you are, and I did in fact miss it, then try adding ".Value" behind the range.

Hello

I changed to this now:
=======================================================

Sub asddddddddddddd()
' Works in Excel 2000, Excel 2002, Excel 2003, Excel 2007, Excel 2010, Outlook 2000, Outlook 2002, Outlook 2003, Outlook 2007, and Outlook 2010.
Dim OutApp As Object
Dim OutMail As Object
Dim cell As Range



Application.ScreenUpdating = False


Set OutApp = CreateObject("Outlook.Application")
On Error GoTo cleanup
For Each cell In Columns("B").Cells.SpecialCells(xlCellTypeConstants)
If cell.Value Like "?*@?*.?*" Then
Set OutMail = OutApp.CreateItem(0)
On Error Resume Next
With OutMail
.To = cell.Value
.Subject = "Reminder"
.Body = "Dear " & Cells(cell.Row, "A").Value _
& vbNewLine & vbNewLine & _
"Please contact us to discuss bringing " & _
"your account up to date"
.Attachments.Add ThisWorkbook.Sheets("Sheet1").Range("C" & cell.Row)
.Send 'Or use Display.
End With
On Error GoTo 0
Set OutMail = Nothing
Set oMail = Nothing
Set oApp = Nothing
End If
Next cell

cleanup:
Set OutApp = Nothing
Application.ScreenUpdating = True
End Sub
=================================================

It stills not sending any attachment.

Help please

 

[shaker93]

Re: Question

Also to this

======================
Sub asddddddddddddd()
' Works in Excel 2000, Excel 2002, Excel 2003, Excel 2007, Excel 2010, Outlook 2000, Outlook 2002, Outlook 2003, Outlook 2007, and Outlook 2010.
Dim OutApp As Object
Dim OutMail As Object
Dim cell As Range



Application.ScreenUpdating = False


Set OutApp = CreateObject("Outlook.Application")
On Error GoTo cleanup
For Each cell In Columns("B").Cells.SpecialCells(xlCellTypeConstants)
If cell.Value Like "?*@?*.?*" Then
Set OutMail = OutApp.CreateItem(0)
On Error Resume Next
With OutMail
.To = cell.Value
.Subject = "Reminder"
.Body = "Dear " & Cells(cell.Row, "A").Value _
& vbNewLine & vbNewLine & _
"Please contact us to discuss bringing " & _
"your account up to date"
.Attachments.Add ThisWorkbook.Sheets("Sheet1").Value.Range("C" & cell.Row)
.Send 'Or use Display.
End With
On Error GoTo 0
Set OutMail = Nothing
Set oMail = Nothing
Set oApp = Nothing
End If
Next cell

cleanup:
Set OutApp = Nothing
Application.ScreenUpdating = True
End Sub
=========================

Nothing happens

 

[jproffer]

Re: Question

If ".Value" is going to do it, it needs to be at the end.

.Attachments.Add ThisWorkbook.Sheets("Sheet1").Range("C" & cell.Row).Value

 

[Fluff]

Re: Question

Is ThisWorkbook.Sheets("Sheet1") the active sheet when you run the macro?
Also, do you just have the file path in col C, or is it the path & filename?

 

[shaker93]

Re: Question

If ".Value" is going to do it, it needs to be at the end.

.Attachments.Add ThisWorkbook.Sheets("Sheet1").Range("C" & cell.Row).Value

Didn't work

 

[shaker93]

Re: Question

Is ThisWorkbook.Sheets("Sheet1") the active sheet when you run the macro?
Also, do you just have the file path in col C, or is it the path & filename?

1.- Yeah, it is. It has the same name as Sheet1
2.- Path with filename ex. C:\Users\shaker\Desktop\test

 

[Fluff]

Re: Question

Try adding the extension to the file name.