starsky
12-15-2011, 10:19 AM
Hi,
I've been amending some code for emailing reports. The line that errors is Attachment.Add line etc. It doesn't seem to like how the filepath is written. If I write the full path for a single file it works fine. I want someone to be able to go through a list of recipients held in cells in column A, and for the relevant report will be referenced by 'SER'. I want excel to find the relevant file based on the partial file title held 2 cells to the right of the recipient cell.
Any ideas?
Thanks.
Sub EmailReport()
Dim OL As Object, W As Object, MailSendItem As Object, olMailItem As Object
Dim MsgTxt As String, SendFile As String, SER As String, RecipientList As String
'On Error GoTo ErrHandler:
RecipientList = Selection
SER = Selection.Offset(0, 2).Value
MsgBox ("Choose a Word document with the email body you wish to send")
SendFile = Application.GetOpenFilename(Title:="Select MS Word " & _
"file to mail, then click 'Open'", buttontext:="Send", _
MultiSelect:=False)
Set W = GetObject(SendFile)
MsgTxt = W.Range(Start:=W.Paragraphs(1).Range.Start, _
End:=W.Paragraphs(W.Paragraphs.Count).Range.End)
Set W = Nothing
Set OL = CreateObject("Outlook.Application")
Set MailSendItem = OL.CreateItem(0)
With MailSendItem
.Subject = Sheets("email").Range("B2").Text
.Body = MsgTxt
.Attachments.Add "C:\Folder\" & SER & "*.xls"
.CC = Sheets("email").Range("C2").Text
.BCC = Sheets("email").Range("D2").Text
.Importance = Sheets("email").Range("E2").Value
.to = RecipientList
.Send
End With
Set OL = Nothing
'ErrHandler:
' MsgBox ("Macro failed. Try again")
' Exit Sub
End Sub
I've been amending some code for emailing reports. The line that errors is Attachment.Add line etc. It doesn't seem to like how the filepath is written. If I write the full path for a single file it works fine. I want someone to be able to go through a list of recipients held in cells in column A, and for the relevant report will be referenced by 'SER'. I want excel to find the relevant file based on the partial file title held 2 cells to the right of the recipient cell.
Any ideas?
Thanks.
Sub EmailReport()
Dim OL As Object, W As Object, MailSendItem As Object, olMailItem As Object
Dim MsgTxt As String, SendFile As String, SER As String, RecipientList As String
'On Error GoTo ErrHandler:
RecipientList = Selection
SER = Selection.Offset(0, 2).Value
MsgBox ("Choose a Word document with the email body you wish to send")
SendFile = Application.GetOpenFilename(Title:="Select MS Word " & _
"file to mail, then click 'Open'", buttontext:="Send", _
MultiSelect:=False)
Set W = GetObject(SendFile)
MsgTxt = W.Range(Start:=W.Paragraphs(1).Range.Start, _
End:=W.Paragraphs(W.Paragraphs.Count).Range.End)
Set W = Nothing
Set OL = CreateObject("Outlook.Application")
Set MailSendItem = OL.CreateItem(0)
With MailSendItem
.Subject = Sheets("email").Range("B2").Text
.Body = MsgTxt
.Attachments.Add "C:\Folder\" & SER & "*.xls"
.CC = Sheets("email").Range("C2").Text
.BCC = Sheets("email").Range("D2").Text
.Importance = Sheets("email").Range("E2").Value
.to = RecipientList
.Send
End With
Set OL = Nothing
'ErrHandler:
' MsgBox ("Macro failed. Try again")
' Exit Sub
End Sub