Hello,

For the following code Destwb is a new workbook created and sent to an
end-user. I am attempting to delete all buttons and a few rows from this new
workbook prior to sending but the code is not working. Any suggestions? (This
is only a portion of the code)

With Destwb
.SaveAs FName
Dim shp As Shape
Dim cell As Range

For Each shp In ActiveSheet.Shapes
shp.Delete
Next shp

For Each cell In ActiveSheet.Range("a86:a120")
If cell.Value = False Then
cell.EntireRow.Delete
End If
Next

Dim VBProj As VBIDE.VBProject
Dim VBComp As VBIDE.VBComponent
Dim CodeMod As VBIDE.CodeModule
Set VBProj = Destwb.VBProject

For Each VBComp In VBProj.VBComponents
If VBComp.Type = vbext_ct_Document Then
Set CodeMod = VBComp.CodeModule
With CodeMod
.DeleteLines 1, .CountOfLines
End With
Else
VBProj.VBComponents.Remove VBComp
End If
Next VBComp
ActiveSheet.Protect ("qconly")

On Error Resume Next


With OutMail

For Each cell In ThisWorkbook.Sheets("Summary").Range("ae91:ae117")
If cell.Value Like "*@*.*" And cell.Offset(0, 1).Value = True Then
strto = strto & cell.Value & ";"
End If
Next cell
For Each cell In ThisWorkbook.Sheets("Summary").Range("ae91:ae117")
If cell.Value Like "*@*.*" And cell.Offset(0, 2).Value = True Then
ccto = ccto & cell.Value & ";"
End If
Next cell
.To = strto
.CC = ccto
.BCC = ""
.Subject = ThisWorkbook.Sheets("Summary").Range("B1").Value &
"Summary Report"
.Body = ThisWorkbook.Sheets("Summary").Range("b100").Value
.Attachments.Add FName
'You can add other files also like this
'.Attachments.Add ("C:\test.txt")
.Send 'or use .Display
End With

On Error GoTo 0
.Close savechanges:=False
End With
'Delete the file you have sent
Kill FName

Set OutMail = Nothing
Set OutApp = Nothing

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