Point to "Contacts" in email 2007
 

Hello from Steved

I've created a "distribution list" in the "Contacts folder" ( Outlook 2007 )
how can I
please tell the below macro where to look. "Yes below works as it should as
Ive tested it using my name in the "SYSTEM FOLDER".

The reason being is that the company has created a "SYSTEM FOLDER" in which
I cannot use to build a Distribution list.

Sub MailToDepots()
'Working in 97-2007
Dim wb As Workbook
Dim Shname As Variant
Dim Addr As Variant
Dim N As Integer
Dim TempFilePath As String
Dim TempFileName As String
Dim FileExtStr As String
Dim FileFormatNum As Long

Shname = Array("1-City", "1-City", "2-Roskill", "Roskill Tutor",
"3-Papakura", "4-Wiri", "5-Shore", "6-Orewa", "7-Swanson", "8-Panmure")
Addr = Array("steve dee", "1-Depot", "2-Depot", "2-Depot", "4-Depot",
"4-Depot", "5-Depot", "5-Depot", "7-Depot", "1-Depot")


If Val(Application.Version) = 12 Then
'You run Excel 2007
FileExtStr = ".xls": FileFormatNum = 56
Else
'You run Excel 97-2003
FileExtStr = ".xls": FileFormatNum = -4143
End If

With Application
.ScreenUpdating = False
.EnableEvents = False
End With

TempFilePath = Environ$("temp") & "\"

'Create the new workbooks/Mail it/Delete it
For N = LBound(Shname) To UBound(Shname)

TempFileName = "Sheet " & Shname(N) & " " & Format(Now, "dd-mmm-yy
h-mm-ss")

ThisWorkbook.Sheets(Shname(N)).Copy
With ActiveSheet.UsedRange
.Copy
.PasteSpecial Paste:=xlPasteValues
End With
Set wb = ActiveWorkbook

With wb
.SaveAs TempFilePath & TempFileName & FileExtStr, FileFormatNum
On Error Resume Next
.SendMail Addr(N), _
"Driver Annulments"
On Error Resume Next
.Close SaveChanges:=False
End With

Kill TempFilePath & TempFileName & FileExtStr

Next N

With Application
.ScreenUpdating = True
.EnableEvents = True
End With
End Sub