Email macro to search directory and email files according to criteria

[Richynero]

Hello Mr Excel fans,

First post here so break me in gently.

I have a folder with numerous spreadsheets, for arguments sake lets say North.xls, East.xls, South.xls and West.xls . Each file contains one sheet that has the same name as the file is named.

Now, I have a seperate spreadsheet called stakeholderlist.xls located in the same directory that lists the files, a stakeholder name and their email address. I would like a macro to go through the file names in the stakeholder workbook, search for the file name in the folder, when the file is found email it (outlook 2003) using the email address in the adjacent field.

I have written code to send emails before (both early and late binding) but Im not sure about delving into a directory.

Office 2003 environment with the necessary reference libraries installed.

Any help would be greatly appreciate.

In return I shall do a random good deed to someone I encounter on my way home.

 

[Richynero]

Sub SendMail()
For i = 2 To 4
MyFile = Cells(i, 1).Value
Subj = Cells(i, 2).Value
EmailTo = Cells(i, 3).Value
CCto = Cells(i, 4).Value
User = Cells(i, 5).Value
msg = "Dear" & User & vbNewLine & "Please find attached your audit trail" & " King regards " & vbNewLine & vbNewLine & Application.UserName
Workbooks.Open FileName:="[URL="file://\\folder\tops"]\folder\top[/URL] secret\" & MyFile, UpdateLinks:=False
Call SendAttachment
Application.DisplayAlerts = False
Workbooks(MyFile).Close
Application.DisplayAlerts = True
Next i
End Sub
 
Public Sub SendAttachmentExample()
    Dim OutApp As Object
    Dim OutMail As Object
    Set OutApp = CreateObject("Outlook.Application")
    Set OutMail = OutApp.CreateItem(0)
    On Error Resume Next
    With OutMail
        .To = EmailTo
        .CC = CCto
        .BCC = ""
        .Subject = Subj
        .Body = msg
        .Attachments.Add ActiveWorkbook.FullName
        .Send
    End With
    On Error GoTo 0
    Set OutMail = Nothing
    Set OutApp = Nothing
End Sub

For some reason the above code does not work.

The following code does work but it is very basic as it just uses the .sendmail command which does not allow me to include any text into the body of mail.

Sub BasicEmail()
 
For i = 2 To 4
MyFile = Cells(i, 1).Value
Subj = Cells(i, 2).Value
EmailTo = Cells(i, 3).Value
CCto = Cells(i, 4).Value
User = Cells(i, 5).Value
msg = "Dear" & User & vbNewLine & "Please find attached your audit trail" & " King regards " & vbNewLine & vbNewLine & Application.UserName
Workbooks.Open FileName:="[URL="file://\\folder\topscretz"]\folder\topscret[/URL]\" & MyFile, UpdateLinks:=False
ActiveWorkbook.SendMail Recipients:=[EMAIL="bob@bobmail.com"]bob@bobmail.com[/EMAIL], Subject:="Audit Trail:" & ActiveWorkbook.Name
Application.DisplayAlerts = False
Workbooks(MyFile).Close
Application.DisplayAlerts = True
Next i
 
End Sub

Any ideas guys?

 

[daverunt]

Hi,

Try this. The bits in red are spaces required or typos.

Sub SendMail()
 
Dim OutApp As Object
Dim OutMail As Object
 
For i = 2 To 4
MyFile = Cells(i, 1).Value
subj = Cells(i, 2).Value
EmailTo = Cells(i, 3).Value
ccTo = Cells(i, 4).Value
User = Cells(i, 5).Value
Msg = "Dear[COLOR=red] "[/COLOR] & User & vbNewLine & [COLOR=red]" [/COLOR]Please find attached your audit trail" & " Kin[COLOR=red]d[/COLOR] regards " & vbNewLine & vbNewLine & Application.UserName
Workbooks.Open FileName:="[URL="file://folder/tops"]\folder\top[/URL] secret\" & MyFile, UpdateLinks:=False
 
    Set OutApp = CreateObject("Outlook.Application")
    Set OutMail = OutApp.CreateItem(0)
    On Error Resume Next
    With OutMail
        .To = EmailTo
        .CC = ccTo
        .BCC = ""
        .Subject = subj
        .body = Msg
        .Attachments.Add ActiveWorkbook.FullName
        .Display
    End With
    On Error GoTo 0
    Set OutMail = Nothing
    Set OutApp = Nothing
 
Application.DisplayAlerts = False
Workbooks(MyFile).Close
Application.DisplayAlerts = True
Next i
End Sub

 

[Richynero]

Thanks Dave for spotting those misgivings.

Although when I made your changes the code didnt run. It looks like the variables defiend in the first procedure were not getting fed into the second. I have combined the 2 procedures and now the code works great.

The columns run from A to E, Filename (inc extension), subject, To, CC and Stakeholer name.

Sub SendMail()
For i = 2 To 4
MyFile = Cells(i, 1).Value
Subj = Cells(i, 2).Value
EmailTo = Cells(i, 3).Value
CCto = Cells(i, 4).Value
User = Cells(i, 5).Value
msg = "Dear " & User & vbNewLine & " Please find attached your audit trail" & " Kind regards " & vbNewLine & vbNewLine & Application.UserName
Workbooks.Open FileName:="\folder\secretlocation\" & MyFile, UpdateLinks:=False
Dim OutApp As Object
    Dim OutMail As Object
    Set OutApp = CreateObject("Outlook.Application")
    Set OutMail = OutApp.CreateItem(0)
    On Error Resume Next
    With OutMail
        .To = EmailTo
        .CC = CCto
        .BCC = ""
        .Subject = Subj
        .Body = msg
        .Attachments.Add ActiveWorkbook.FullName
        .Send
    End With
    On Error GoTo 0
    Set OutMail = Nothing
    Set OutApp = Nothing
Application.DisplayAlerts = False
Workbooks(MyFile).Close
Application.DisplayAlerts = True
Next i
End Sub

 

[daverunt]

Hi

My fault the code is the same bar the fact I changed the .Send to .Display.
Using .Display allows you to check the mail format and then press Send on the created mail or cancel, which is useful for testing. Otherwise you may get a load of crap - or someone else does- in Outlook that you don't really want.

The variables can be declared as global for use when you call another sub but in this case not worth the hassle.

 

[Richynero]

Ahaa! .Display may will prove useful in some instances. I could put a flag in my main sheet that would allow the user to amend the default message if required.

Thanks for your help!

 

[SJ-NY]

Hi

I am using Outlook 2010.

I was searching the site for posts on how to email an excel file as an attachment and I came across this posting. My situation matches yours 100%. I copied the macro and started to Step through it but at this line:

Set OutApp = CreateObject("Outlook.Application")

I got a run time error "429" "Active X component can't create object"

Do you know how I can fix this.

Thanks

Steve

 

[Richynero]

Have you got all the references from the correct object libraries?

If you got into the IDE, Tools -> References and then look for the one that says Microsoft Outlook 12 ( I think 12 is your version could be anything from 10 to 12).

Onec you have added that it might work.

Any more probs email me the file and I will have a look at it if you like.

http://msdn.microsoft.com/en-us/library/ff458119(office.11).aspx

http://msdn.microsoft.com/en-us/library/ff519602(office.11).aspx

 

[SJ-NY]

Hi
It is your code. The reference library available to me is "Microsoft Outlook 14.0 Object Library.

The problem is still occuring at the same line:

Set OutApp = CreateObject("Outlook.Application")

Thanks

Steve