Below is the code for a button so when pressed YES it will save and the email
the relevant people to say its been accepted, if NO i need it to go to a
default location and then send an outlook email to say its been refused,

At the moment if i press NO it works fine but if i press yes it will send
both the accepted email and the declined, this is probably something stupid
but please help.


Private Sub CommandButton1_Click()

ActiveWorkbook.Save

Dim Response As String
Dim DefaultFolder As String, DefaultFileName As String
Dim FileToSave
Dim OutApp As Object 'this emails operations manager
Dim OutMail As Object
Dim strbody As String

Response = MsgBox("Are you sure you want to Approve this PIP?", _
vbYesNo + vbInformation + vbDefaultButton2)

If Response = vbYes Then

Range("C13:C75") = Date

Dim lngRow As Long, rngTemp As Range
Dim wbBook As Workbook, wsDest As Worksheet

Set rngTemp = ActiveSheet.Range("A13:Q75")
Set wbBook = Workbooks.Open("C:\Documents and
Settings\neil.holden\Desktop\test2.xls")
Set wsDest = wbBook.Sheets("Sheet1") 'Destination sheet
With rngTemp

lngRow = wsDest.Cells(Rows.Count, "A").End(xlUp).Row + 1

wsDest.Range("A" & lngRow).Resize(rngTemp.Rows.Count, _
rngTemp.Columns.Count) = rngTemp.Value

End With
wbBook.Close True

DefaultFolder = "M:\Procurement\Approved PIPS"
If Right(DefaultFolder, 1) < "\" Then
DefaultFolder = DefaultFolder & "\"
End If
DefaultFileName = "Project Brief" & " for " &
Sheets("PIP").Range("A13").Value
If Right(UCase(DefaultFileName), 3) < "XLS" Then
DefaultFileName = DefaultFileName & " " & _
Format(Date, "dd-mm-yyyy") & ".xls"
End If
FileToSave = Application.GetSaveAsFilename _
(DefaultFolder & DefaultFileName, filefilter:="Excel Files (*.xls)," _
& "*.xls", Title:="Save File As...")
If FileToSave = False Then
Exit Sub
Else
ThisWorkbook.SaveAs _
Filename:=FileToSave, _
FileFormat:=ActiveWorkbook.FileFormat
End If
End If

If Response = vbYes Then

Set OutApp = CreateObject("Outlook.Application")
OutApp.Session.Logon
Set OutMail = OutApp.CreateItem(0)

strbody = "PIP" & " for " & Sheets("PIP").Range("A13").Value & " " & _
Sheets("PIP").Range("a13").Value & " " & "PIP ACCEPTED"

On Error Resume Next
With OutMail
.To = ; "
.CC = ""
.BCC = ""
.Subject = "PIP Accepted"
.Body = strbody
.Send 'or use .Display
End With
On Error GoTo 0

Set OutMail = Nothing
Set OutApp = Nothing
Application.DisplayAlerts = True
Application.ScreenUpdating = True


End If

If Response = vbNo Then
DefaultFolder = "M:\Procurement\Declined PIPS"
If Right(DefaultFolder, 1) < "\" Then
DefaultFolder = DefaultFolder & "\"
End If
DefaultFileName = "Declined PIP" & " for " &
Sheets("PIP").Range("A13").Value
If Right(UCase(DefaultFileName), 3) < "XLS" Then
DefaultFileName = DefaultFileName & " " & _
Format(Date, "dd-mm-yyyy") & ".xls"
End If
FileToSave = Application.GetSaveAsFilename _
(DefaultFolder & DefaultFileName, filefilter:="Excel Files (*.xls)," _
& "*.xls", Title:="Save File As...")
If FileToSave = False Then
Exit Sub
Else
ThisWorkbook.SaveAs _
Filename:=FileToSave, _
FileFormat:=ActiveWorkbook.FileFormat
End If
End If



Set OutApp = CreateObject("Outlook.Application")
OutApp.Session.Logon
Set OutMail = OutApp.CreateItem(0)

strbody = "PIP" & " for " & Sheets("PIP").Range("A13").Value & " " & _
Sheets("PIP").Range("C10").Value & " " & "PIP DECLINED"

On Error Resume Next
With OutMail
.To = ; "
.CC = ""
.BCC = ""
.Subject = "PIP Declined"
.Body = strbody
.Send 'or use .Display
End With
On Error GoTo 0

Set OutMail = Nothing
Set OutApp = Nothing
Application.DisplayAlerts = True
Application.ScreenUpdating = True

Exit Sub




End Sub