Email files with same names from folder

[CCkfm2000]

Hello,

I have folder with over 250 worksheets, I want to attach all worksheets with the same name to an email ready for emailing. Examples worksheet names below.


Appraisals fred.smith 14622
Appraisals fred.smith 14611
Appraisals fred.smith 14618
Appraisals john.bloggs 14641
Appraisals john.bloggs 14642
Appraisals john.bloggs 14643
Appraisals john.bloggs 14643
Appraisals john.bloggs 14644
Appraisals john.bloggs 14645
Appraisals Nigel.who14512

Some of the work sheets might be single files while others will be more.

I’ve got this code but can’t find a way to group the names together to email.



Sub create_email_for_editing()
Dim olApp As Outlook.Application
Dim olMail As Outlook.MailItem
Set olApp = CreateObject("Outlook.Application")
Set olMail = olApp.CreateItem(olMailItem)
filedete = WorksheetFunction.CountA(Range("a1:a100"))
With olMail
.To = "name@domain.com"
.Subject = "email subject"
.Body = "email message"
.Attachments.Add "c:\eLearning data\*.xls", olByValue, 1
.Display
End With
End Sub

Thanks for the help

[GTO]

Hello,

I have folder with over 250 worksheets, I want to attach all worksheets with the same name to an email ready for emailing. Examples worksheet names below...

Just to clarify, do you mean over 250 workbooks?

Reference:


Appraisals john.bloggs 14644
Appraisals john.bloggs 14645
Appraisals Nigel.who14512

Presuming you mean workbooks, does the '.xls' extension not show? I cannot recall if this matters, but in case...

Now as to the names: I believe we would need a dependable 'rule' to extract and compare part of the filename. From the above, the only inconsistancy I see is that there is a space missing between the employee's name and appraisal number reference the last appraisal. Can we count on this pattern?

Mark

[CCkfm2000]

sorry

yes all workbooks with ext .xls

Appraisals john.bloggs 14644.xls
Appraisals john.bloggs 14645.xls
Appraisals Nigel.who14512.xls

yes thats the pattern

a space after the word Appraisals
a full stop between the first name and last name
another space before the number.

thanks for looking into this...

[GTO]

No problems and actually I should have thought of what I think could be an easier way to begin with. Rather than worrying about any pattern, would it seem better to just let the user pick the files to attach?

We can set the initial folder and drive as shown, and use a multiselect open dialog I think. Try:

Option Explicit

Sub exa()
Dim FileNameArray As Variant, i As Long
'// Update Drive and Directory to suit. //
' ChDrive "G"
ChDir "G:\2010\2010-04-15\"
FileNameArray = Application.GetOpenFilename( _
FileFilter:="Excel Workbooks (*.xls), *.xls", _
Title:="Select any/all files to attach...", MultiSelect:=True)
If IsArray(FileNameArray) Then
For i = LBound(FileNameArray) To UBound(FileNameArray)
MsgBox "Attach " & FileNameArray(i) & " here."
Next
Else
Exit Sub
End If
End Sub

Hope that helps,

Mark

[CCkfm2000]

Thanks Mark,

The reason I want this to be able to email lots people from a list i'll have in a workbook, at the moment it takes me over an hour to email all the workbooks.

Thanks for the help.

[mdmackillop]

I would consider zipping the workbooks first. Ron de Bruin uses a free zip utility in this solution (http://www.rondebruin.nl/7zipwithexcel.htm)