S
Steved
Hello from Steved I've copied the below from another computer which worked
fine but now we have upgraded it partly works. What is required please.
The below macro will use the only the bottom three and works like a treat
but it will not email the rest. "1-Depot", has 2 email address and works
along with 2-Roskill, but it will not send Addr = Array "4-Depot" for
speadsheets Shname = Array "3-Papakura","4-Wiri" and Addr = Array 5-Depot for
speadsheets Shname = Array "5-Shore","6-Orewa" and Addr = Array "7-Depot",
for Spreadsheet Shname = Array "7-Swanson", and also Addr = Array 1-City for
Spreadsheet Shname = Array "8-Panmure"
?-Depots each have 2 email address ( Distribution List )
Shname = Array("1-City", "2-Roskill", "2-Roskill"
Addr = Array("1-Depot", "2-Depot", "Roskill Tutor",
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", "2-Roskill", "2-Roskill", "3-Papakura",
"4-Wiri", "5-Shore", "6-Orewa", "7-Swanson", "8-Panmure")
Addr = Array("1-Depot", "2-Depot", "Roskill Tutor", "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
Thankyou.
fine but now we have upgraded it partly works. What is required please.
The below macro will use the only the bottom three and works like a treat
but it will not email the rest. "1-Depot", has 2 email address and works
along with 2-Roskill, but it will not send Addr = Array "4-Depot" for
speadsheets Shname = Array "3-Papakura","4-Wiri" and Addr = Array 5-Depot for
speadsheets Shname = Array "5-Shore","6-Orewa" and Addr = Array "7-Depot",
for Spreadsheet Shname = Array "7-Swanson", and also Addr = Array 1-City for
Spreadsheet Shname = Array "8-Panmure"
?-Depots each have 2 email address ( Distribution List )
Shname = Array("1-City", "2-Roskill", "2-Roskill"
Addr = Array("1-Depot", "2-Depot", "Roskill Tutor",
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", "2-Roskill", "2-Roskill", "3-Papakura",
"4-Wiri", "5-Shore", "6-Orewa", "7-Swanson", "8-Panmure")
Addr = Array("1-Depot", "2-Depot", "Roskill Tutor", "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
Thankyou.