View Single Post
  #1   Report Post  
Posted to microsoft.public.excel.programming
ssGuru ssGuru is offline
external usenet poster
 
Posts: 63
Default EMail Outlook failing

I had the email code shown below working just fine. No problems.
I moved the Excel files to the root drive in a sub folder and added
some other code.
Now the following code behind a EMail Reports button fails at the KILL
statement near the end where it is supposed to delete the temorary
file it created as an attachment. I can see the file in the Environment
%/TEMP location and the code variable shows the correct path though it
is hard to tell.

PROBLEM: I get OUT OF MEMORY errors popups (twice) which are actually
referring to Resource Memory I think.
"Excel cannot complete this task with available resources. Choose
less data or close other applications"

Manually attaching the files to an email causes no problems. The file
as attached is only 104kb. Plenty of HD space. 1Gb RAM. XP Pro.
Same kinds of errors on other test machines and OS.

So it seems to me that the code is failing at the KILL since it can't
do it's thing. The email actually gets sent even though the process
appears to have failed. But the error windows and the debug window
would confuse a user.

I also expect and do see the Outlook dialogue box "...A program is
trying to automatically send e-mail....." where I expect the user to
choose "YES".

Is there a way to test for a file with the same name in the users/
local settings/TEMP and delete it first or allow an overwrite??

Thanks for any advice,
Dennis

EMAIL BUTTON CODE IN QUESTION:
Private Sub btnEMail_Click()
'Works in Excel 97-2007, Tested with Outlook
Dim FileExtStr As String
Dim FileFormatNum As Long
Dim Sourcewb As Workbook
Dim Destwb As Workbook
Dim TempFilePath As String
Dim TempFileName As String
Dim sh As Worksheet
Dim RptCreator As String
Dim ReportDate As String
Dim eMain As String, eCopy1 As String, eCopy2 As String, eCopy3 As
String

With Application
.ScreenUpdating = False
.EnableEvents = False
End With
Set Sourcewb = ActiveWorkbook

'Copy the sheets to a new workbook
Sourcewb.Sheets(Array("DDInstructionPrice", "DDProspects")).Copy
Set Destwb = ActiveWorkbook

'Determine the Excel version and file extension/format
With Destwb
If Val(Application.Version) < 12 Then
'You use Excel 97-2003
FileExtStr = ".xls": FileFormatNum = -4143
Else
'You use Excel 2007
'We exit the sub when your answer is NO in the security dialog that
you only
'see when you copy sheets from a xlsm file with macro's disabled.
If Sourcewb.Name = .Name Then
With Application
.ScreenUpdating = True
.EnableEvents = True
End With
MsgBox "Your answer is NO in the security dialog"
Exit Sub
Else
Select Case Sourcewb.FileFormat
Case 51: FileExtStr = ".xlsx": FileFormatNum = 51
Case 52:
If .HasVBProject Then
FileExtStr = ".xlsm": FileFormatNum = 52
Else
FileExtStr = ".xlsx": FileFormatNum = 51
End If
Case 56: FileExtStr = ".xls": FileFormatNum = 56
Case Else: FileExtStr = ".xlsb": FileFormatNum = 50
End Select
End If
End If
End With

'DD Save the new workbook/Mail it/Delete it
TempFilePath = Environ$("temp") & "\"
eMain = Range("eMailMain").Value
eCopy1 = Range("eMailCopy1").Value
eCopy2 = Range("eMailCopy2").Value
eCopy3 = Range("eMailCopy3").Value
RptCreator = Range("RptCreator").Value
ReportDate = Range("RptDate").Value
'TempFileName = RptCreator & "-" & Sourcewb.Name
'TempFileName = RptCreator & "_" & Format(ReportDate, "yymmdd") &
" Forecast"
TempFileName = Format(ReportDate, "yymmdd") & "-Forecast-" &
RptCreator
With Destwb

'DD TEST .SaveAs TempFilePath & TempFileName & FileExtStr,
FileFormat:=FileFormatNum
.SaveAs TempFilePath & TempFileName, FileFormat:=FileFormatNum
On Error Resume Next
'DD TEST .SendMail "emailaddress", "This is the Subject line"
'.SendMail eMailList, RptCreator & " Forcast " & ReportDate
.SendMail Recipients:=Array(eMain, eCopy1, eCopy2, eCopy3),
Subject:=(RptCreator & " Forcast " & ReportDate)
On Error GoTo 0
.Close savechanges:=False
End With

'DD Kill TempFilePath & TempFileName & FileExtStr
Kill TempFilePath & TempFileName ''THIS IS WHERE IT FAILS
'DD reset variables
eCopy1 = ""
eCopy2 = ""
eCopy3 = ""
RptCreator = ""
ReportDate = ""
With Application
.ScreenUpdating = True
.EnableEvents = True
End With
End Sub