PDA

View Full Version : Email macro failing



dcgrove
07-10-2009, 10:04 AM
can someone help me troubleshot this macro? it creates the second worksheet just fine, it just doesn't send the actual email. This same code works in several other workbooks fine, but when I put it in this one, it doesn't.
:banghead::banghead:


Sub Mail_Range()
' Works in Excel 2000 through Excel 2007.
Dim Source As Range
Dim Destwb As Workbook
Dim wb As Workbook
Dim TempFilePath As String
Dim TempFileName As String
Dim FileExtStr As String
Dim FileFormatNum As Long

ActiveSheet.Unprotect
Set Source = Nothing
On Error Resume Next
Set Source = Range("A1:O40").SpecialCells(xlCellTypeVisible)
On Error GoTo 0

If Source Is Nothing Then
MsgBox "The source is not a range or the worksheet is protected. Please correct the problem and try again.", vbOKOnly
Exit Sub
End If

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

Set wb = ActiveWorkbook
Set Destwb = Workbooks.Add(xlWBATWorksheet)

Source.Copy
With Destwb.Sheets(1)
' The number 8 pastes the column width. Because of
' of a bug in Excel 2000, you must use the number
' instead of “xlPasteColumnWidths”.
.Cells(1).PasteSpecial Paste:=8
.Cells(1).PasteSpecial Paste:=xlPasteValues
.Cells(1).PasteSpecial Paste:=xlPasteFormats
.Cells(1).Select
Application.CutCopyMode = False
End With

TempFilePath = Environ$("temp") & "\"
TempFileName = "" & wb.Name & " " & Format(Now, "dd-mmm-yy")

If Val(Application.Version) < 12 Then
' You are using Excel 2000 through Excel 2003.
FileExtStr = ".xls": FileFormatNum = -4143
Else
' You are using Excel 2007.
FileExtStr = ".xlsx": FileFormatNum = 51
End If

With Destwb
.SaveAs TempFilePath & TempFileName & FileExtStr, FileFormat:=FileFormatNum
On Error Resume Next
.SendMail "nospam@nospam.com", _
Sheets("sheet1").Range("a2").Value
On Error GoTo 0
.Close savechanges:=False
End With

' Delete the file you just sent.
Kill TempFilePath & TempFileName & FileExtStr

With Application
.ScreenUpdating = True
.EnableEvents = True
End With
ActiveSheet.Protect DrawingObjects:=False, Contents:=True, Scenarios:= _
False
End Sub

Bob Phillips
07-10-2009, 10:22 AM
It worked for me.

It did throw up an Outlook warning, which I just managed to Yes before it timed out, but then it send okay. This warning is an Outlook security feature, you can get around this with http://www.dimastr.com/redemption/