mduff
03-08-2005, 11:37 AM
Hi All I set up this code to send a workbook to a distribution list. On my system with Excel 2000 and outlook 2000 it's working fine but when I give this same sheet to some one with excel 2002 and outlook 2002 when it gets to the code in BOLD instead of sending the sheet it opens IE and locks up excel
Any ideas if I need to add something to the code form use with office 2002 or a setting or something any help is really appreciated
Sub Mail_SheetsArray()
Dim Arr() As String
Dim N As Integer
Dim cell As Range
N = 0
For Each cell In Columns("G").Cells.SpecialCells(xlCellTypeConstants)
If cell.EntireRow.Hidden = False And cell.Value Like "*@*" Then
N = N + 1
ReDim Preserve Arr(1 To N)
Arr(N) = cell.Value
End If
Next cell
Dim wb As Workbook
Dim ws As Worksheet
Dim strdate As String
strdate = Format(Now - 1, "dd-mm-yy")
Application.ScreenUpdating = False
Sheets("Summary").Select
ActiveSheet.Copy
For Each ws In Worksheets
With ws.UsedRange
.Value = .Value
End With
Next
Set wb = ActiveWorkbook
With wb
.SaveAs "C:\MS-EL-SAL Summary" _
& " " & strdate & ".xls"
On Error Resume Next
.SendMail Arr, Subject:=Sheets("Summary").Range("A1").Value
.ChangeFileAccess xlReadOnly
MsgBox "Email Sent"
On Error GoTo 0
Kill .FullName
.Close False
End With
Application.ScreenUpdating = True
Sheets("Master").Select
End Sub
Any ideas if I need to add something to the code form use with office 2002 or a setting or something any help is really appreciated
Sub Mail_SheetsArray()
Dim Arr() As String
Dim N As Integer
Dim cell As Range
N = 0
For Each cell In Columns("G").Cells.SpecialCells(xlCellTypeConstants)
If cell.EntireRow.Hidden = False And cell.Value Like "*@*" Then
N = N + 1
ReDim Preserve Arr(1 To N)
Arr(N) = cell.Value
End If
Next cell
Dim wb As Workbook
Dim ws As Worksheet
Dim strdate As String
strdate = Format(Now - 1, "dd-mm-yy")
Application.ScreenUpdating = False
Sheets("Summary").Select
ActiveSheet.Copy
For Each ws In Worksheets
With ws.UsedRange
.Value = .Value
End With
Next
Set wb = ActiveWorkbook
With wb
.SaveAs "C:\MS-EL-SAL Summary" _
& " " & strdate & ".xls"
On Error Resume Next
.SendMail Arr, Subject:=Sheets("Summary").Range("A1").Value
.ChangeFileAccess xlReadOnly
MsgBox "Email Sent"
On Error GoTo 0
Kill .FullName
.Close False
End With
Application.ScreenUpdating = True
Sheets("Master").Select
End Sub