[Okta Webinar] Learn how to a build a cloud-first strategyRegister Now

x
  • Status: Solved
  • Priority: Medium
  • Security: Public
  • Views: 1773
  • Last Modified:

Excel Macro - Outlook "Save & Send"

We have an Excel form on a Public Drive, that personnel can complete and email. The Shared worksheet and workbook are protected. Since this is a Public form used by all personnel, we do not want them to save the entries that they made. This way the next user will start with a blank form.

Previously, we instructed them to go to "File \ Save & Send \ Send As Attachment" to email the file. However, it is essential that the Subject Line is coded correctly, and that will never happen.

So we added a Button that creates an email, fills in the Subject Line, and attaches the Excel form. But when we receive the Excel form it is blank. Can "Save & Send \ Send As Attachment" be coded in a Macro ?

The code that we currently have is below.

Any insight or assistance would be greatly appreciated.

Tosagua



Private Sub CommandButton2_Click()

 'Working in Excel 2000-2013
     If Len(Dir(ThisWorkbook.Path & Application.PathSeparator & "Bypass Field Check.txt")) = 0 Then
       For Each Cell In Sheets("PREMIUM FREIGHT APPROVAL FORM").[D7,D9,F42,G44,D46,D48,D50,D52,D54] ' <- change these cell references to suit
          If Len(Cell) = 0 Then
             MsgBox "There Are Entries Missing. All Information Is Required. "
             Cell.Activate
             Exit Sub
          End If
       Next Cell
    End If

    Dim OutApp As Object
    Dim OutMail As Object

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

    On Error Resume Next
    With OutMail
        .To = " "
        .CC = ThisWorkbook.Sheets("PREMIUM FREIGHT APPROVAL FORM").Range("D7").Value
        .Subject = ThisWorkbook.Sheets("PREMIUM FREIGHT APPROVAL FORM").Range("P64").Value
        .Body = "Requesting Approval For Premium Freight Charges.   Please Review And Advise."
        .Attachments.Add ActiveWorkbook.FullName
        'You can add other files also like this
        '.Attachments.Add ("C:\test.txt")
        .Display   'or use .Send
    End With
    On Error GoTo 0

    Set OutMail = Nothing
    Set OutApp = Nothing
End Sub

Open in new window

0
Tosagua
Asked:
Tosagua
  • 6
  • 5
1 Solution
 
Ejgil HedegaardCommented:
The attachment in the mail code is ActiveWorkbook.FullName, and that is the saved workbook you start with, not the changed workbook you are working with.

Use this instead, to opens the Excel send dialog, with recipients and subject.
No need to create an Outlook object.

Application.Dialogs(xlDialogSendMail).Show "Recipients", "Subject"

Open in new window

0
 
TosaguaAuthor Commented:
Ejgil Hedegaard,

I apologize for the delay.

The code attached the form with the entries that were made. Perfect.
But we also need:

.To = " "  -  This in blank because the email could be sent to number of different people, not known in advance.

.CC = ThisWorkbook.Sheets("PREMIUM FREIGHT APPROVAL FORM").Range("D7").Value - This value on the form is the "Requester's Email Address, so on Reply, they will receive the approval (or not).

.Subject = ThisWorkbook.Sheets("PREMIUM FREIGHT APPROVAL FORM").Range("P64").Value - This value is a Reference Number on the form. Unique Identifier.

.Body = "Requesting Approval For Premium Freight Charges.   Please Review And Advise."

Your assistance is appreciated.

Tosagua
Example:
Request-Email.docx

Code Used:
Private Sub CommandButton2_Click()

 'Working in Excel 2000-2013
     If Len(Dir(ThisWorkbook.Path & Application.PathSeparator & "Bypass Field Check.txt")) = 0 Then
       For Each Cell In Sheets("PREMIUM FREIGHT APPROVAL FORM").[D7,D9,F42,G44,D46,D48,D50,D52,D54] ' <- change these cell references to suit
          If Len(Cell) = 0 Then
             MsgBox "There Are Entries Missing. All Information Is Required. "
             Cell.Activate
             Exit Sub
          End If
       Next Cell
    End If

    Application.Dialogs(xlDialogSendMail).Show "Recipients", "Subject"

   
    With OutMail
        .To = " "
        .CC = ThisWorkbook.Sheets("PREMIUM FREIGHT APPROVAL FORM").Range("D7").Value
        .Subject = ThisWorkbook.Sheets("PREMIUM FREIGHT APPROVAL FORM").Range("P64").Value
        .Body = "Requesting Approval For Premium Freight Charges.   Please Review And Advise."
        .Attachments.Add ActiveWorkbook.FullName
        'You can add other files also like this
        '.Attachments.Add ("C:\test.txt")
        .Display   'or use .Send
    End With
    On Error GoTo 0

   
End Sub
0
 
Ejgil HedegaardCommented:
Application.Dialogs(xlDialogSendMail).Show, only accepts 3 arguments, Recipients, Subject, ReturnReceipt.
Recipients is the mail addresses to send to, divided with semicolon if more than one.
Subject is what you want as subject text, and can be
ThisWorkbook.Sheets("PREMIUM FREIGHT APPROVAL FORM").Range("P64").Value

In total
Application.Dialogs(xlDialogSendMail).Show " ", ThisWorkbook.Sheets("PREMIUM FREIGHT APPROVAL FORM").Range("P64").Value

Open in new window

opens the outlook dialog with "To" pre filled with a space (not blank, use "" for blank), and the value in P64 as subject, and the workbook attached as it is now.

CC and Body is not possible to pre fill.
It is exactly the same as using Send as attachment, except To and Subject can be set.
When you use Send as attachment, you also has to fill To, CC, and Body.
Excel only set subject to the file name.
The rest you have to do.

If you want to use something like the OutMail code, with the possibility to add cc and body text, the mail addresses to send to must be known, because the final command .Display, sends the message without delay.
But attachments can only be saved files, so to send the file as it is now, it has to be saved with a different name than the empty form, and the saved file used as attachment.
But then you have a file you don't want, and the workbook in use will have the name used when saved.
The "temporary" file can not be deleted, since it is used now.

To avoid having a lot of not needed files, a workaround could be to delete all "temporary" files from yesterday and before, when the empty form is opened.
It requires that all files are saved in a known folder all users have access to save to.
The easiest is to use the folder where the empty form is, or a subfolder to that.
0
Independent Software Vendors: We Want Your Opinion

We value your feedback.

Take our survey and automatically be enter to win anyone of the following:
Yeti Cooler, Amazon eGift Card, and Movie eGift Card!

 
TosaguaAuthor Commented:
Ejgil,

I went back to creating an Outlook Object, as that produces the email that we need.

But after the code, that checks the nine cells to ensure that they are filled in, I added "ThisWorkbook.Save".  This is before the code that creates the email. Then after the code that creates the email and attchment I added "ThisWorkbook.Close". The attached form now retains all of the entries. Since the To: section on the email is empty, the .Display command does not send the email. It has to be filled in, and the Requester has to hit Send. This is blazing fast.


Now, a macro is needed that runs when the workbook is opened, to delete the values in the nine cells that required entries. This would, I hope, essentially create a blank form for the next user. Is this possible ?

Tosagua
0
 
Ejgil HedegaardCommented:
Have never used empty To, nice to know that the dialog stops.

To clear the cells, you can use the same syntax as the cell check for Commandbutton2.

Insert this in the module ThisWorkbook.

Option Explicit

Private Sub Workbook_Open()
    Dim Cell As Range
    For Each Cell In Sheets("PREMIUM FREIGHT APPROVAL FORM").[D7,D9,F42,G44,D46,D48,D50,D52,D54]
        Cell.ClearContents
    Next Cell
End Sub

Open in new window

0
 
TosaguaAuthor Commented:
Ejgil,

So close. But these are Merged Cells, and you cannot change part of a Merged Cell.
However, if the Merged Cells are assigned names ("Cost", "Shipper", "Reciever", etc.) , can these ranges be listed to be cleared ?

Tosagua
0
 
TosaguaAuthor Commented:
Ejgil,

I inserted this code into the ThisWorkbook module. But when the Email Receiver opens the attachment it is blank.
It seems that the code needs to be file specific.



End Sub
Option Explicit

Private Sub Workbook_Open()

Range("D7:I7").ClearContents
Range("Freight_Cost").ClearContents
Range("F42:I42").ClearContents
Range("G44:I44").ClearContents
Range("D46:I46").ClearContents
Range("D48:I48").ClearContents
Range("D50:I50").ClearContents
Range("D52:I52").ClearContents
Range("D54:I57").ClearContents

End Sub

Open in new window

0
 
TosaguaAuthor Commented:
Ejgil,

It was easier than I thought possible.
After the code that ensures all entries have been made: ThisWorkbook.Save
Then the code to create the email and attach the workbook
Then code to delete the cell contents.
ThisWorkbook.Save
ThisWorkbook.Close

The email has the completed form, and the next person to open the file, has a blank form.

I tried it three times and it worked well.
Now, we will put into a test group to ensure it is solid.

Greatly appreciate your assistance.

Tosagua






Private Sub CommandButton2_Click()

 'Working in Excel 2000-2013
     If Len(Dir(ThisWorkbook.Path & Application.PathSeparator & "Bypass Field Check.txt")) = 0 Then
       For Each Cell In Sheets("PREMIUM FREIGHT APPROVAL FORM").[D7,D9,F42,G44,D46,D48,D50,D52,D54] ' <- change these cell references to suit
          If Len(Cell) = 0 Then
             MsgBox "There Are Entries Missing. All Information Is Required. "
             Cell.Activate
             Exit Sub
          End If
       Next Cell
    End If

    ThisWorkbook.Save

    Dim OutApp As Object
    Dim OutMail As Object

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

    On Error Resume Next
    With OutMail
        .To = " "
        .CC = ThisWorkbook.Sheets("PREMIUM FREIGHT APPROVAL FORM").Range("D7").Value
        .Subject = ThisWorkbook.Sheets("PREMIUM FREIGHT APPROVAL FORM").Range("P64").Value
        .Body = "Requesting Approval For Premium Freight Charges.   Please Review And Advise."
        .Attachments.Add ActiveWorkbook.FullName
        'You can add other files also like this
        '.Attachments.Add ("C:\test.txt")
        .Display   'or use .Send
    End With
    On Error GoTo 0

    Set OutMail = Nothing
    Set OutApp = Nothing

    
Range("D7:I7").ClearContents
Range("Freight_Cost").ClearContents
Range("F42:I42").ClearContents
Range("G44:I44").ClearContents
Range("D46:I46").ClearContents
Range("D48:I48").ClearContents
Range("D50:I50").ClearContents
Range("D52:I52").ClearContents
Range("D54:I57").ClearContents

ThisWorkbook.Save
ThisWorkbook.Close

End Sub

Open in new window

0
 
TosaguaAuthor Commented:
Ejgil,

You got me pointed in the right direction.

I appreciate the help.

Tosagua
0
 
Ejgil HedegaardCommented:
To avoid clear the cells, when the workbook is send, add an identifier in a cell somewhere, so the code to clear is skipped when the workbook opens.
Could be named ClearOnOpen on a hidden sheet.
Then before the workbook is saved before send, set ClearOnOpen to 0.
And after the workbook has been send, change ClearOnOpen to 1, and save the workbook again.

Or don't use the workbook open event to clear the cells.
Save the workbook before send.
Then clear the cells after send, and save the workbook again.
Then the identifier is not needed.


Code to clear in workbook event, also handling the merged cells.

Option Explicit

Private Sub Workbook_Open()
    Dim Cell As Range
    If [ClearOnOpen] = 1 Then
        For Each Cell In Sheets("PREMIUM FREIGHT APPROVAL FORM").[D7,D9,F42,G44,D46,D48,D50,D52,D54]
            If Cell.MergeArea.Address = Cell.Address Then
                Cell.ClearContents
            Else
                Range(Cell.MergeArea.Address).ClearContents
            End If
        Next Cell
    End If
End Sub

Open in new window

0
 
Ejgil HedegaardCommented:
The posting crossed.
I see you have used the second option.
0

Featured Post

Industry Leaders: We Want Your Opinion!

We value your feedback.

Take our survey and automatically be enter to win anyone of the following:
Yeti Cooler, Amazon eGift Card, and Movie eGift Card!

  • 6
  • 5
Tackle projects and never again get stuck behind a technical roadblock.
Join Now