Re: Email Code needs a LITTLE Tweaking. Help PLEASE.

[JONBR]

Re: Email Code needs a LITTLE Tweaking. Help PLEASE.

I'm using more or less the same email button code as Mister H in his thread, borrowed and slightly modified to suit my needs. What I'm trying to do now is get the same button-click to ensure all "required fields" are filled in prior to emailing, and if not, displaying a MsgBox to that effect instead of emailing the document. I have formulas hidden in the spreadsheet to determine whether or not the necessary fields are full, and a single cell (P9) with an If formula yielding "OK" if all requirements are fulfilled and "NOT OK" if there are still blanks. Any help would be appreciated, thanks. I've attached Mister H's code below, but mine is close to identical.

 Sub EmailNoticeToOSS()
' Macro recorded 07/07/2009 by Mark Huggins
'Prepare E-Mail (Working in 2000-2007)
    Dim FileExtStr As String
    Dim FileFormatNum As Long
    Dim Sourcewb As Workbook
    Dim Destwb As Workbook
    Dim TempFileName As String
    Dim OutApp As Object
    Dim OutMail As Object
 
    With Application
        .ScreenUpdating = False
        .EnableEvents = False
    End With
 
    Set Sourcewb = ActiveWorkbook
 
'Copy the sheet to a new workbook
    ActiveSheet.Copy
    Set Destwb = ActiveWorkbook
 
'Determine the Excel version and file extension/format
    With Destwb
        If Val(Application.Version) < 12 Then
'You use Excel 2000-2003
            FileExtStr = ".xls": FileFormatNum = -4143
        Else
'You use Excel 2007
'We exit the sub when your answer is NO in the security dialog that you only
'see  when you copy a sheet from a xlsm file with macro's disabled.
            If Sourcewb.Name = .Name Then
                With Application
                    .ScreenUpdating = True
                    .EnableEvents = True
                End With
                MsgBox "Your answer is NO in the security dialog"
                Exit Sub
            Else
                Select Case Sourcewb.FileFormat
                Case 51: FileExtStr = ".xlsx": FileFormatNum = 51
                Case 52:
                    If .HasVBProject Then
                        FileExtStr = ".xlsm": FileFormatNum = 52
                    Else
                        FileExtStr = ".xlsx": FileFormatNum = 51
                    End If
                Case 56: FileExtStr = ".xls": FileFormatNum = 56
                Case Else: FileExtStr = ".xlsb": FileFormatNum = 50
                End Select
            End If
        End If
    End With
 
'Change all cells in the worksheet to values
 
        Application.ScreenUpdating = False
 
        With Destwb.Sheets(1).UsedRange
            .Cells.Copy
            .Cells.PasteSpecial xlPasteValues
            .Cells(1).Select
        End With
        Application.CutCopyMode = False
 
'Delete Button
    Sheets("Refund Form").Select
    ActiveSheet.Shapes("Button 2").Select
    Selection.Delete
 
    Application.ScreenUpdating = True
 
'Delete Data Validation in cell K7 so that it can not be altered.
    Range("K7").Select
    With Selection.Validation
        .Delete
        .Add Type:=xlValidateInputOnly, AlertStyle:=xlValidAlertStop, Operator _
        :=xlBetween
        .IgnoreBlank = True
        .InCellDropdown = True
        .ShowInput = True
        .ShowError = True
    End With
 
 
'Save the new workbook
    FilePath = "C:\Test4Darren\"
    TempFileName = FilePath & ActiveSheet.Range("K7") & " " & ActiveSheet.Range("B10")
 
[COLOR=red][B]'If the file already exists and the user chooses NOT to replace the existing file (user clicks NO or CANCEL) then I need to Exit Sub[/B][/COLOR]
[COLOR=red][B]'If Answer = vbNo Then Exit Sub[/B][/COLOR]
 
    
 
 
 
 
 
    Set OutApp = CreateObject("Outlook.Application")
    OutApp.Session.Logon
    Set OutMail = OutApp.CreateItem(0)
 
    With Destwb
        .SaveAs TempFileName & FileExtStr, FileFormat:=FileFormatNum
        On Error Resume Next
        With OutMail
            .To = "[EMAIL="test.test@ontario.ca"][COLOR=#304c6c]test.test@ontario.ca[/COLOR][/EMAIL]"
            .CC = ""
            .BCC = ""
            .Subject = ActiveSheet.Range("K7") & " " & ActiveSheet.Range("B10")
            .Body = "An Accounts Receivable Refund Request form has been created for the above mentioned customer for your review and processing." [COLOR=red][B]'Is there anyway to get a link in here that would take you directly to the file mentioned in the email?[/B][/COLOR]
 
    
 
 
 [COLOR=red][B]   'is there any way to send this without getting a WARNING Message?[/B][/COLOR]
            .Send       
 
 
    End With
        On Error GoTo 0
        .Close savechanges:=False
    End With
 
    Set OutMail = Nothing
    Set OutApp = Nothing
 
    With Application
        .ScreenUpdating = True
        .EnableEvents = True
    End With
 
    'Now SAVE the original workbook
    ActiveWorkbook.Save
 
End Sub

 

[wigi]

Re: Email Code needs a LITTLE Tweaking. Help PLEASE.

Welcome to MrExcel.

Then, at the top of the code, at a line saying:

If Range("P9").Value <> "OK" Then 'add the sheet name if not the active sheet
   MsgBox "not all fields filled in", vbCritical,"Error"
   Exit Sub
End If

 

[JONBR]

Re: Email Code needs a LITTLE Tweaking. Help PLEASE.

Perfect; exactly what I was looking for. Thanks.