S
Steved
Hello from Steved
I've created distribution lists in the Contacts ( Outlook 2007) how can I
please tell the below macro where to look.
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
I've created distribution lists in the Contacts ( Outlook 2007) how can I
please tell the below macro where to look.
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