Send Out Macro not workig with PDF

[New_Keith]

Hi Again,

Having an issue trying to send out some pdf files using a macro through outlook. The Error is coming up as a run time error 287 and highlighting the .send function. The report works on picking name and email from the file it then picks up the links and attaches them until it finds a blank cell then sends them out. its worked with excel files but not picking up the pdf files. i have just put the links in for ref but i have the full correct links to the files in the report.

Any help will be gratefully received just been racking my brain for a day with no joy.

the report looks like this.

[TABLE="width: 500"]
<tbody>[TR]
[TD]Spare[/TD]
[TD]Name[/TD]
[TD]Email Address[/TD]
[TD]Email Subject[/TD]
[TD]Spare[/TD]
[TD]Links[/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD][/TD]
[TD]ABC,[/TD]
[TD]ABC.ABC&Gmail.com[/TD]
[TD]M02 Cost Centre Reports[/TD]
[TD][/TD]
[TD]\\Link 1.pdf[/TD]
[TD]\\Link 2.pdf[/TD]
[TD]\\Link 3.pdf[/TD]
[/TR]
[TR]
[TD][/TD]
[TD]CDE,[/TD]
[TD]CDE.CDE&Gmail.com[/TD]
[TD]M02 Cost Centre Reports[/TD]
[TD][/TD]
[TD]\\Link 4.pdf[/TD]
[TD]\\Link 5.pdf[/TD]
[TD][/TD]
[/TR]
</tbody>[/TABLE]



The Macro code is this:


Sub Send_Files


Dim Message As Object
Dim SendData As Object
Dim RawData As Worksheet
Dim cell As Range, FileCell As Range, rng As Range

With Application
.EnableEvents = False
.ScreenUpdating = False
End With
Set RawData = Sheets("Cardio & Resp")
Set Message = CreateObject("Outlook.Application")
Message.Session.Logon
For Each cell In RawData.Columns("C").Cells.SpecialCells(xlCellTypeConstants)

Set rng = RawData.Cells(cell.Row, 1).Range("F1:Z1")
If cell.Value Like "?*@?*.?*" And _
Application.WorksheetFunction.CountA(rng) > 0 Then
Set SendData = Message.CreateItem(0)
With SendData
.to = cell.Value
.Subject = cell.Offset(0, 1)
.Body = "Hi " & cell.Offset(0, -1).Value & Chr(10) & Chr(10) & "Please find attachment of the monthly cost centre reports."
For Each FileCell In rng.SpecialCells(xlCellTypeConstants)
If Trim(FileCell) <> "" Then
If Dir(FileCell.Value) <> "" Then
.Attachments.Add FileCell.Value
End If
End If
Next FileCell
.send
End With
Set SendData = Nothing
End If
Next cell
Set Message = Nothing
With Application
.EnableEvents = True
.ScreenUpdating = True
End With
End Sub



Thanks Again for any help.

Cheers,
Keith.

 

[Ruddles]

You probably don't want to hear this but your code works perfectly on my system (Windows 7 & Office 2007), whether Outlook is open or not.

I've seen a couple of people suggest inserting a short delay before doing the .send: Application.Wait Now() + TimeValue("00:00:02")

Worth a try?

 

[New_Keith]

Hi Ruddles,

Thanks for the response just out of question is the file paths you are choosing PDFs? I find that i can get it to work with excel files but not PDFs.

Cheers,
Keith.

 

[Ruddles]

Yes - PDFs.

 

[Ruddles]

What about other file types - TXT, DOC, JPG, HTM, etc?

 

[Ruddles]

Check the contents of FileCell.Value very carefully - make sure it holds exactly what you're expecting.

 

[New_Keith]

It's still not running I am guessing the problem is with the attaching the file. Is there a setting to get it to add as when I'm in excel and press F2 then enter it isn't creating the hyperlink like it used to. I've even tried one file and just taking it from my documents and its not picking it up just keeps coming back with the same error.

Any ideas as help will be very much appreciated.

Thanks again for your continued support in helping with this query.

Best wishes,
Keith.

 

[Ruddles]

What about other file types - TXT, DOC, JPG, HTM, etc? Is it just PDFs that it's complaining about or is it everything except Excel files that it's doesn't like?