N
Neil Holden
Below is the code, i've been told to use an input box but i'm clueless as to
how to do this, can you help me on this matter which would be greatly
appreciated.
Sub Macro()
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 save the PIP report?", _
vbYesNo + vbInformation + vbDefaultButton2)
If Response = vbYes Then
strbody = "PIP" & " for " & Sheets("PIP").Range("A13").Value & " " & _
Sheets("PIP").Range("B13").Value & " " & "Ready For Review"
Set EmailAddr = Application.InputBox("Select Email Address" & vbCrLf & _
"Hold down Contrl Key to select multiple addresses", Type:=8)
Destination = ""
For Each cell In EmailAddr
If Destination = "" Then
Destination = cell
Else
Destination = Destination & ";" & cell
End If
Next cell
ActiveWorkbook.Save
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 & " " & "Ready For Review"
On Error Resume Next
With OutMail
.To = Response
.CC = ""
.BCC = ""
.Subject = "PIP Ready For Review"
.Body = strbody
.Send 'or use .Display
End With
On Error GoTo 0
Set OutMail = Nothing
Set OutApp = Nothing
Application.DisplayAlerts = True
Application.ScreenUpdating = True
'If Response = vbYes Then
' DefaultFolder = "M:\Contract\Current\Nationwide\Templates\Project
'Brief&SOR\Project Briefs to be Approved prior to sending inc master SOR
'Project brief"
'If Right(DefaultFolder, 1) <> "\" Then
' DefaultFolder = DefaultFolder & "\"
'End If
'DefaultFileName = Range("C7")
'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
End If
End Sub
how to do this, can you help me on this matter which would be greatly
appreciated.
Sub Macro()
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 save the PIP report?", _
vbYesNo + vbInformation + vbDefaultButton2)
If Response = vbYes Then
strbody = "PIP" & " for " & Sheets("PIP").Range("A13").Value & " " & _
Sheets("PIP").Range("B13").Value & " " & "Ready For Review"
Set EmailAddr = Application.InputBox("Select Email Address" & vbCrLf & _
"Hold down Contrl Key to select multiple addresses", Type:=8)
Destination = ""
For Each cell In EmailAddr
If Destination = "" Then
Destination = cell
Else
Destination = Destination & ";" & cell
End If
Next cell
ActiveWorkbook.Save
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 & " " & "Ready For Review"
On Error Resume Next
With OutMail
.To = Response
.CC = ""
.BCC = ""
.Subject = "PIP Ready For Review"
.Body = strbody
.Send 'or use .Display
End With
On Error GoTo 0
Set OutMail = Nothing
Set OutApp = Nothing
Application.DisplayAlerts = True
Application.ScreenUpdating = True
'If Response = vbYes Then
' DefaultFolder = "M:\Contract\Current\Nationwide\Templates\Project
'Brief&SOR\Project Briefs to be Approved prior to sending inc master SOR
'Project brief"
'If Right(DefaultFolder, 1) <> "\" Then
' DefaultFolder = DefaultFolder & "\"
'End If
'DefaultFileName = Range("C7")
'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
End If
End Sub