Solved: 2007 Email Script help

[Emoncada]

I have this script that worked fine in Office 2003. Now I modified it to a new spreadsheet but in 2007. It's giving me an error.

Option Explicit

Sub eMailActiveWorksheet()

Range("C3:C36").Select
Selection.Copy
ActiveWindow.SmallScroll Down:=-63
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False

Range("G3:G23").Select
Selection.Copy
ActiveWindow.SmallScroll Down:=-63
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False

Columns("A:C").Select
Range("C1").Activate
Selection.EntireColumn.Hidden = False
Columns("B:B").Select
Selection.Delete Shift:=xlToLeft

Columns("D:F").Select
Range("F1").Activate
Selection.EntireColumn.Hidden = False
Columns("E:E").Select
Selection.Delete Shift:=xlToLeft

'Date
Range("G1").Select
Selection.Copy
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False

ActiveSheet.Buttons.Visible = False

Dim OL As Object
Dim EmailItem As Object
Dim Wb As Workbook
Dim FileName As String
Dim y As Long
Dim TempChar As String
Dim SaveName As String

Application.ScreenUpdating = False
Set OL = CreateObject("Outlook.Application")
Set EmailItem = OL.CreateItem(olMailItem)
FileName = ActiveSheet.Name & " - " & ActiveWorkbook.Name
For y = 1 To Len(FileName)
TempChar = Mid(FileName, y, 1)
Select Case TempChar
Case Is = "/", "\", "*", "?", """", "<", ">", "|", ":"
Case Else
SaveName = SaveName & TempChar
End Select
Next y
ActiveSheet.Copy
Set Wb = ActiveWorkbook
Wb.SaveAs SaveName
Wb.ChangeFileAccess xlReadOnly
With EmailItem
.Subject = "Phone Inventory"
.Body = "Attached Is The Phone Inventory" ' & vbCrLf & _
"Line 2" & vbCrLf & _
"Line 3"
.To = "jsmith@yahoo.com"
.CC = ""
.Importance = olImportanceNormal 'Or olImprotanceHigh Or olImprotanceLow
.Attachments.Add Wb.FullName
.Send
End With
Kill Wb.FullName
Wb.Close False

Application.ScreenUpdating = True

Set Wb = Nothing
Set OL = Nothing
Set EmailItem = Nothing

Range("G1").Select
ActiveCell.FormulaR1C1 = "=Today()"

'Insert B column again with data
Columns("B:B").Select
Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
Range("B3").Select
ActiveCell.FormulaR1C1 = "=Data!RC"
Range("B3").Select
Selection.AutoFill Destination:=Range("B3:B36"), Type:=xlFillDefault
Range("B3:B36").Select
ActiveWindow.SmallScroll Down:=-18
With Selection
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlBottom
.WrapText = False
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With
With Selection.Interior
.Pattern = xlNone
.TintAndShade = 0
.PatternTintAndShade = 0
End With
Columns("B:B").ColumnWidth = 9
Columns("B:B").ColumnWidth = 8.43
Range("B3:B36").Select
Selection.Borders(xlDiagonalDown).LineStyle = xlNone
Selection.Borders(xlDiagonalUp).LineStyle = xlNone
With Selection.Borders(xlEdgeLeft)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With Selection.Borders(xlEdgeTop)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With Selection.Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With Selection.Borders(xlEdgeRight)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With Selection.Borders(xlInsideVertical)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With Selection.Borders(xlInsideHorizontal)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
Range("A3:C36").Select
Selection.Borders(xlDiagonalDown).LineStyle = xlNone
Selection.Borders(xlDiagonalUp).LineStyle = xlNone
With Selection.Borders(xlEdgeLeft)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlMedium
End With
With Selection.Borders(xlEdgeTop)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlMedium
End With
With Selection.Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlMedium
End With
With Selection.Borders(xlEdgeRight)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlMedium
End With
With Selection.Borders(xlInsideVertical)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With Selection.Borders(xlInsideHorizontal)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
'Insert Formula back For Updated Quantity.
Range("C3").Select
ActiveCell.FormulaR1C1 = _
"=RC[-1]+SUMIF(Incoming!C[-2],RC[-2],Incoming!C[-1])-SUMIF(Outgoing!C[-2],RC[-2],Outgoing!C[-1])"
Range("C4").Select
ActiveCell.FormulaR1C1 = _
"=RC[-1]+SUMIF(Incoming!C[-2],RC[-2],Incoming!C[-1])-SUMIF(Outgoing!C[-2],RC[-2],Outgoing!C[-1])"
Selection.AutoFill Destination:=Range("C4:C36"), Type:=xlFillDefault
Range("C4:C36").Select

'Insert F column again with data
Columns("F:F").Select
Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
Range("F3").Select
ActiveCell.FormulaR1C1 = "=Data!RC"
Range("F3").Select
Selection.AutoFill Destination:=Range("F3:F23"), Type:=xlFillDefault
Range("F3:F23").Select
With Selection
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlBottom
.WrapText = False
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With
With Selection.Interior
.Pattern = xlNone
.TintAndShade = 0
.PatternTintAndShade = 0
End With
Columns("F:F").ColumnWidth = 9
Columns("F:F").ColumnWidth = 8.43
Selection.Borders(xlDiagonalDown).LineStyle = xlNone
Selection.Borders(xlDiagonalUp).LineStyle = xlNone
With Selection.Borders(xlEdgeLeft)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With Selection.Borders(xlEdgeTop)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With Selection.Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With Selection.Borders(xlEdgeRight)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With Selection.Borders(xlInsideVertical)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With Selection.Borders(xlInsideHorizontal)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
Range("E3:G23").Select
Selection.Borders(xlDiagonalDown).LineStyle = xlNone
Selection.Borders(xlDiagonalUp).LineStyle = xlNone
With Selection.Borders(xlEdgeLeft)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlMedium
End With
With Selection.Borders(xlEdgeTop)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlMedium
End With
With Selection.Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlMedium
End With
With Selection.Borders(xlEdgeRight)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlMedium
End With
With Selection.Borders(xlInsideVertical)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With Selection.Borders(xlInsideHorizontal)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With

'Insert Formula back For Updated Quantity.
Range("G3").Select
ActiveCell.FormulaR1C1 = _
"=RC[-1]+SUMIF(Incoming!C[-2],RC[-2],Incoming!C[-1])-SUMIF(Outgoing!C[-2],RC[-2],Outgoing!C[-1])"
Range("G4").Select
ActiveCell.FormulaR1C1 = _
"=RC[-1]+SUMIF(Incoming!C[-2],RC[-2],Incoming!C[-1])-SUMIF(Outgoing!C[-2],RC[-2],Outgoing!C[-1])"
Selection.AutoFill Destination:=Range("G4:G23"), Type:=xlFillDefault
Range("G4:G23").Select

Range("A2").Select

ActiveSheet.Buttons.Visible = True

End Sub

It's giving me olMailItem is undefined.
Any ideas?

[Bob Phillips]

Replace olMailItem by 0 (zero).

That code could do with a good tidy.

[Emoncada]

That works but it stops at the

Kill Wb.FullName

gives me access denied.

Would you know why? it's not protected.

[Bob Phillips]

Maybe the mail still has it.

Try releasing the mail object before killing it,

[Emoncada]

So where should I edit it.

Something like this?


Set Wb = Nothing
Set OL = Nothing
Set EmailItem = Nothing


Kill Wb.FullName
Wb.Close False

Application.ScreenUpdating = True

[Emoncada]

So where should I edit it.

Something like this?



Set Wb = Nothing
Set OL = Nothing
Set EmailItem = Nothing


Kill Wb.FullName
Wb.Close False

Application.ScreenUpdating = True

[Bob Phillips]

Basically, but don't clear down the Wb object, just OL and EmailItem.

[Emoncada]

I'm still having problems. It keeps giving me that error.

Run-time error '70':
Permission Denied.

Any ideas?

Is there another way to kill it without using Kill?

[Bob Phillips]

Sorry, I think you were right, close WB, then release the objects including Wb, then kill the file. Give that a try.

[Emoncada]

Ok this is the way I set it up.

Set Wb = Nothing
Set OL = Nothing
Set EmailItem = Nothing

Kill Wb.FullName

Application.ScreenUpdating = True
Wb.Close False

It's now giving me

Kill Wb.FullName <Object Variable or With Block variable not set>

[Bob Phillips]

I was meaning something more like



WbName = Wb.Fullname

Wb.Close False

Set Wb = Nothing
Set OL = Nothing
Set EmailItem = Nothing

Kill WbName

Application.ScreenUpdating = True

[Emoncada]

worked great XLD Thanks once again.