N
Neil Holden
Hi all Guru, I have created a button which emails the addresses as shown
below, what i would prefer if i could have it so that it emails what ever
email address is in cell B10, instead of having set email addresses.
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)
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("b13").Value & " " & "has been accepted"
On Error Resume Next
With OutMail
.To = "(e-mail address removed); (e-mail address removed)"
.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
below, what i would prefer if i could have it so that it emails what ever
email address is in cell B10, instead of having set email addresses.
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)
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("b13").Value & " " & "has been accepted"
On Error Resume Next
With OutMail
.To = "(e-mail address removed); (e-mail address removed)"
.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