Try this


Sub loopworkbooks()

Dim BKName As String
Dim DistList As String
Dim BKNames() As String

'create sdistribution list
With ActiveWorkbook.ActiveSheet

'get distribution list from column A
LastRow = .Range("A" & Rows.Count).End(xlUp).Row
Set DistributionRange = .Range("A1:A" & LastRow)

'make string of email address seperated by semicolon

DistList = ""
For Each cell In DistributionRange
If DistList = "" Then
DistList = cell.Value
Else
'add semicolon between email names
DistList = DistList & ";" & cell.Value
End If
Next cell
End With


Folder = "C:\temp\"


'Create an array of book names
ArrayCount = 0
FName = Dir(Folder & "*.xls")
Do While FName < ""

BKName = Folder & FName
ReDim Preserve BKNames(0 To ArrayCount)
BKNames(ArrayCount) = BKName
ArrayCount = ArrayCount + 1
FName = Dir()
Loop
Call Mail_workbook_Outlook_1(BKNames, DistList)



End Sub


Sub Mail_workbook_Outlook_1(BKNames As Variant, _
DistList As String)

'Working in 2000-2007
'This example send the last saved version of the Activeworkbook

Set OutApp = CreateObject("Outlook.Application")
OutApp.Session.Logon
Dim OutMail As Object

Set OutMail = OutApp.CreateItem(0)

On Error Resume Next
With OutMail
.To = DistList
.CC = ""
.BCC = ""
.Subject = "This is the Subject line"
.Body = "Hi there"

For Each bk In BKNames
.Attachments.Add bk
Next bk
.Send 'or use .Display
End With
On Error GoTo 0

Set OutMail = Nothing
Set OutApp = Nothing

End Sub


--
joel
------------------------------------------------------------------------
joel's Profile: http://www.thecodecage.com/forumz/member.php?userid=229
View this thread: http://www.thecodecage.com/forumz/sh...d.php?t=148971