Jumat, 18 Agustus 2017

Send excel use email with macro

Different Ways to Take Advantage of the E-mail Features of Excel

Office 2003

 
Ron de Bruin
Microsoft Excel MVP
Frank C. Rice
Microsoft Corporation
August 2003
Applies to:
    Microsoft® Excel 97 and later versions
Summary: Microsoft Excel MVP Ron de Bruin provides a number of samples and a handy add-in that enhances your experience when working with e-mail from Excel. From sending individual worksheets in a workbook to sending e-mail to multiple recipients, the code samples and add-in should become a part of your reference library. The SendMail 2.0 add-in and a user guide is available from http://www.rondebruin.nl. (13 printed pages)

Contents

Introduction

This article features code samples, a wizard, and an add-in utility that you can use to perform various e-mail functions from Microsoft Excel. Ron de Bruin, an Excel Most Valuable Professional (MVP) and a frequent contributor to the newsgroups provided the samples and add-in.
Note   You should be aware of the two main security features for Outlook 2002 and later versions (and with a security patch for Outlook 2000):
  • Blocking of a customizable list of file attachments considered unsafe because they can be used to propagate viruses.
  • Pop-up confirmation dialogs that occur whenever a program accesses address-related properties or attempts to send a message.
These constraints can affect the way you interact with Outlook in the following procedures.

Sending E-mail in Excel

One way to send e-mail from Excel is to the use the Mail Merge Wizard which is only available in Excel 2000 and later versions (called the Mail Merge Helper in Excel 2000). The Mail Merge Wizard simplifies the batch creation of letters, sending of e-mail messages, creating postal mailing labels, labeling envelopes for postal mail, and creating directory lists. You can find more detailed information about the Mail Merge Wizard by reading the Excel help topic titled Create a Word mail merge with Excel data.
Another way to use the e-mail features of Excel are with the code samples discussed in this article. In addition to augmenting your own code, you can use the samples provided here as a starting point to better help you understand how you can send as e-mail the various objects and data in your own worksheets and workbooks. Several samples also include alternate ways of modifying the code to send just the piece of information you want.
Yet another way to send mail is to use the SendMail 2.0 add-in utility created by Ron de Bruin. The SendMail 2.0 utility gives you the ability to send all or part of a workbook either in working format or with just the values of the current data and formulas. Once you install SendMail 2.0, to access these features, click Tools, and then click SendMail.

Before You Send E-mail

Before you use the e-mail features of Excel, either by feeding data to the Mail Merge Wizard or through the Microsoft Visual Basic® for Applications (VBA) code sample in this article, it is a good idea to ensure your data is structured so that there are no surprises. The following criteria are applicable for using the wizard but also improve predictability when using the code samples:
  • Add column headers above each column in the first row such as Title, First Name, Last Name, Address1, and so forth.
  • Ensure that individual pieces of information you want to work with are in separate fields. For example, separating the recipient's name into separate first and last name fields allows you to use just the parts you want for a specific task such as using the last name in a salutation and then combining the first and last fields in the address block in a letter.
  • Ensure that each field name is unique to avoid ambiguity.
  • Ensure each row of data refers to a single entity. For example, each row refers to one recipient.
  • Avoid blank rows in your data.
Note   The VBA code in the following sections was tested in Microsoft Outlook 2002 and Microsoft Outlook Express 6.0. It may or may not work with other e-mail clients.

Send the Active Workbook by E-mail

The following subroutine sends the active workbook where the workbook that contains the code is not the active workbook:
Sub Mail_workbook()
    ActiveWorkbook.SendMail "someone@microsoft.com","Subject_line"
End Sub
To e-mail the workbook that contains the code, then use the following line instead:
ThisWorkbook.SendMail "someone@microsoft.com","Subject_line"
Note   The workbook doesn't have to be the active workbook in use at the time that the code is executed.

Send a Single Sheet by E-mail

The following example illustrates how to send a single sheet in e-mail with the following options:
  • By creating a workbook with just the active sheet
  • By saving the workbook before sending it with a date/time stamp
  • By sending the active workbook
  • By deleting the file from your hard disk after you send it
Sub Mail_ActiveSheet()
    Dim strDate As String
    ActiveSheet.Copy
    strDate = Format(Date, "dd-mm-yy") & " " & Format(Time, "h-mm-ss")
    ActiveWorkbook.SaveAs "Part of " & ThisWorkbook.Name _
        & " " & strDate & ".xls"
    ActiveWorkbook.SendMail "someone@microsoft.com", _
        "Subject_line"
    ActiveWorkbook.ChangeFileAccess xlReadOnly
    Kill ActiveWorkbook.FullName
    ActiveWorkbook.Close False
End Sub
You can use the following line if you know which sheet you want to send:
...
Sheets("Sheet5").Copy 
...
Note   The code doesn't have to be in the active sheet when it is executed.

Send an Array of Worksheets by E-mail

You can use the following sample code to send multiple worksheets in e-mail with the following options:
  • By creating a workbook with two worksheets
  • By saving the workbook before sending it with a date/time stamp
  • By deleting the file from your hard disk after you send it
Sub Mail_SheetsArray()
    Dim strDate As String
    Sheets(Array("Sheet1", "Sheet3")).Copy
    strDate = Format(Date, "dd-mm-yy") & " " & Format(Time, "h-mm-ss")
    ActiveWorkbook.SaveAs "Part of " & ThisWorkbook.Name _
        & " " & strDate & ".xls"
    ActiveWorkbook.SendMail "someone@microsoft.com", _
        "Subject_line"
    ActiveWorkbook.ChangeFileAccess xlReadOnly
    Kill ActiveWorkbook.FullName
    ActiveWorkbook.Close False
End Sub

Send the Selection by E-mail

This subroutine sends a newly created workbook with just the visible cells in the selection. The cells are added as values using Paste Special in the workbook you send.
The routine saves the workbook before sending it by e-mail with a date/time stamp.
After the file is sent, the workbook is deleted from your hard disk.
  • Because it sends only the visible cells, the subroutine also works if you want to send a range with hidden rows or columns in it.
The normal Copy and Paste commands make the hidden rows and columns visible!
Sub Mail_Selection()
    Dim source As Range
    Dim ColumnCount As Long
    Dim FirstColumn As Long
    Dim ColumnWidthArray() As Double
    Dim lIndex As Long
    Dim lCount As Long
    Dim dest As Workbook
    Dim i As Long
    Dim strdate As String
 
    Set source = Nothing
    On Error Resume Next
    Set source = Selection.SpecialCells(xlCellTypeVisible)
    On Error GoTo 0
    If source Is Nothing Then
        MsgBox "The selection is not a range or the sheet is protect, please correct and try again.", vbOKOnly
        Exit Sub
    End If
 If ActiveWindow.SelectedSheets.Count > 1 Or _
       Selection.Cells.Count = 1 Or _
       Selection.Areas.Count > 1 Then
        MsgBox "An Error occurred :" & vbNewLine & vbNewLine & _
               "You have more than one sheet selected." & vbNewLine & _
               "You only selected one cell." & vbNewLine & _
               "You selected more than one area." & vbNewLine & vbNewLine & _
               "Please correct and try again.", vbOKOnly
        Exit Sub
    End If
 
    Application.ScreenUpdating = False
    ColumnCount = Selection.Columns.Count
    FirstColumn = Selection.Cells(1).Column - 1
    ReDim ColumnWidthArray(1 To ColumnCount)
    lIndex = 0
    For lCount = 1 To ColumnCount
        If Columns(FirstColumn + lCount).Hidden = False Then
            lIndex = lIndex + 1
            ColumnWidthArray(lIndex) = Columns(FirstColumn + lCount).ColumnWidth
        End If
    Next lCount
    Set dest = Workbooks.Add(xlWBATWorksheet)
    source.Copy
    With dest.Sheets(1)
        .Cells(1).PasteSpecial xlPasteValues, , False, False
        .Cells(1).PasteSpecial xlPasteFormats, , False, False
        .Cells(1).Select
        Application.CutCopyMode = False
        For i = 1 To lIndex
            .Columns(i).ColumnWidth = ColumnWidthArray(i)
        Next
    End With
    strdate = Format(Now, "dd-mm-yy h-mm-ss")
    With dest
        .SaveAs "Selection of " & ThisWorkbook.Name _
              & " " & strdate & ".xls"
        .SendMail "ron@debruin.nl", _
                  "This is the Subject line"
        .ChangeFileAccess xlReadOnly
        Kill .FullName
        .Close False
    End With
    Application.ScreenUpdating = True
End Sub
You can use this if you know the range you want to send:
Set source = Range("A1:E50").SpecialCells(xlCellTypeVisible)
Range("A1:E50").Select
Then you can remove this section:
If ActiveWindow.SelectedSheets.Count > 1 Or _
       Selection.Cells.Count = 1 Or _
       Selection.Areas.Count > 1 Then
        MsgBox "An Error occurred :" & vbNewLine & vbNewLine & _
               "You have more than one sheet selected." & vbNewLine & _
               "You only selected one cell." & vbNewLine & _
               "You selected more than one area." & vbNewLine & vbNewLine & _
               "Please correct and try again.", vbOKOnly
        Exit Sub
    End If

Sending Specific Worksheets by E-mail

This procedure illustrates how to send every worksheet with an address in cell A1 by e-mail. This way you can send each sheet to another person. It does this by cycling through each worksheet in the workbook and checking cell A1 for the @ character. If found, the code makes a copy of the worksheet and then sends the copy by e-mail to the address in cell A1. Finally, the code deletes the file copy from your hard disk.
Sub Mail_every_Worksheet()
    Dim sh As Worksheet
    Application.ScreenUpdating = False
    For Each sh In ThisWorkbook.Worksheets
        If sh.Range("a1").Value Like "*@*" Then
            sh.Copy
            ActiveWorkbook.SaveAs "Sheet " & sh.Name & " of " _
                & ThisWorkbook.Name & ".xls"
            ActiveWorkbook.SendMail ActiveSheet.Range("a1").Value, _
                "Subject_line"
            ActiveWorkbook.ChangeFileAccess xlReadOnly
            Kill ActiveWorkbook.FullName
            ActiveWorkbook.Close False
        End If
    Next sh
    Application.ScreenUpdating = True
End Sub

Send Worksheets to One or More People by E-mail

To do this, add a sheet with the name mail to your workbook. Then, for every e-mail you want to send, create three columns that include:
  • The sheet or sheets you want to send
  • The e-mail address or addresses
  • The subject of the e-mail
Columns A:C include the information for the first e-mail and D:F for the second one (see Figure 1). You can send 85 different e-mails this way (85*3 = 255 columns).
Figure 1. Send e-mail to multiple people
In this example, the following results:
  • Ron and Dave receive sheet1, sheet3 and sheet5 (in one workbook) and the subject line of "Subject 1"
  • Jelle receives sheet2 and sheet4 (in one workbook) and the subject line of "Subject 2"
The following code accomplishes this:
Sub Mail_sheets()
    Dim MyArr As Variant
    Dim last As Long
    Dim shname As Long
    Dim a As Integer
    Dim Arr() As String
    Dim N As Integer
    Dim strdate As String
    For a = 1 To 253 Step 3
        If ThisWorkbook.Sheets("mail").Cells(1, a).Value = "" Then 
            Exit Sub
        End
        Application.ScreenUpdating = False
        last = ThisWorkbook.Sheets("mail").Cells(Rows.Count, _
            a).End(xlUp).Row
        N = 0
        For shname = 1 To last
            N = N + 1
            ReDim Preserve Arr(1 To N)
            Arr(N) = ThisWorkbook.Sheets("mail").Cells(shname, a).Value
        Next shname
        ThisWorkbook.Sheets(Arr).Copy
        strdate = Format(Date, "dd-mm-yy") & " " & _
            Format(Time, "h-mm-ss")
        ActiveWorkbook.SaveAs "Part of " & ThisWorkbook.Name _
            & " " & strdate & ".xls"
        With ThisWorkbook.Sheets("mail")
            MyArr = .Range(.Cells(1, a + 1), .Cells(Rows.Count, _
                a + 1).End(xlUp))
        End With
        ActiveWorkbook.SendMail MyArr, ThisWorkbook.Sheets("mail").Cells(1, a + 2).Value
        ActiveWorkbook.ChangeFileAccess xlReadOnly
        Kill ActiveWorkbook.FullName
        ActiveWorkbook.Close False
        Application.ScreenUpdating = True
    Next a
End Sub

Tips for Changing the Examples

The preceding macros are just some examples you can use to send e-mail from Excel. The following examples show ways you can change the code to suit your needs.

Keep the File

Delete these lines to keep the file you sent:
...
ActiveWorkbook.ChangeFileAccess xlReadOnly 
Kill ActiveWorkbook.FullName
...

Don't Save the File

Delete these four lines if you don't want to save the workbook:
...
strDate = Format(Date, "dd-mm-yy") & " " & Format(Time, "h-mm-ss")
ActiveWorkbook.SaveAs 
 
ActiveWorkbook.ChangeFileAccess xlReadOnly
Kill ActiveWorkbook.FullName
...

Change the Recipient Line

Use a cell (A1) containing an e-mail address as follows:
...
ActiveWorkbook.SendMail Sheets("mysheet").Range("a1").Value, _
    "Subject_line"
...
Use also a cell for the subject like this.
...
ActiveWorkbook.SendMail Sheets("mysheet").Range("a1").Value, _
    Sheets("mysheet").Range("b1").Value
...
To send e-mail to more people use this line:
...
ActiveWorkbook.SendMail Array("someone@microsoft.com", "someone@microsoft.com"), _
    "Subject_line"
...
To send e-mail to all addresses in a range:
...
Dim MyArr As Variant
MyArr = Sheets("mysheet").Range("c1:c10")
ActiveWorkbook.SendMail MyArr, _
    "Subject_line"
...
If you use this line, you can choose an address in the address book or type one yourself and put some text in the body:
...
ActiveWorkbook.SendMail "", "Subject_line"
...

Change the Save Line

You can change the save line to this, for example:
...
ActiveWorkbook.SaveAs Sheets("mysheet").Range("d1").Value
ActiveWorkbook.SaveAs "myfilename"
...
Important   Use error checking to verify that a file with that name doesn't already exist or isn't already open. In the examples above, the file name includes the date and time so that the chance the file name already exists is very small.

Copy the Cells as Values

To paste cells as values you cannot protect the sheet. Alternatively, you can use unprotect and then protect the worksheet in the subroutine.
Use one of these lines to copy a single sheet:
...
Sh.copy 
...

...
Activesheet.copy 
...
Use this code to paste as values:
...
Cells.Copy
Cells.PasteSpecial xlPasteValues
Cells(1).Select
Application.CutCopyMode = False
...
If you copy more sheets in the newly created workbook then use this:
...
Worksheets.Select
Cells.Copy
Cells.PasteSpecial xlPasteValues
Cells(1).Select
Worksheets(1).Select
Application.CutCopyMode = False
...

The SendMail 2.0 Utility

The SendMail 2.0 utility is an add-in for sending customized Excel workbooks and worksheets by e-mail. In addition, SendMail allows significant customizing of what you send. As soon as you have the workbook open in Excel, you have the ability to send all or part of workbook either with the formatting or with just the values of the current data and formulas. Once you install SendMail 2.0, to access it, click Tools, and then click SendMail.
Note   The SendMail 2.0 utility was tested in Outlook and Outlook Express. It will not work with other e-mail clients.
To install the Send Mail 2.0 utility for Excel 97 or later
  1. Download and extract the SendMail utility to a local directory.
  2. Copy SendMail 2.0.xla to the following directory:
    local_drive:\Program Files\Microsoft Office\OfficeNumber\Library
    Note   Depending on the version of Excel, the OfficeNumber directory may be only Office or may include a number. For example:
    local_drive:\Program Files\Microsoft Office\Office\Library
    -OR-
    local_drive:\Program Files\Microsoft Office\Office11\Library
  3. Open Excel.
    Note   You must have a workbook open.
  4. Click the Tools menu and then click Add-ins.
  5. Click Browse. . . to browse to local_drive:\Program Files\Microsoft Office\Officenumber\Library.
  6. Click SendMail 2.0.xla and then click Open
  7. Verify SendMail 2.0 is checked and then click OK.
For instructions on using SendMail 2.0, see the User Guide included in the download.

Conclusion

In this article, we looked at several code samples you can use to make mailing from Excel much easier. We also introduced the SendMail add-in that you can use to assist you in sending customized Excel workbooks and worksheets by e-mail. Exploring and implementing these tools in your own applications can help make your job as a developer much easier and make your solutions more versatile.
Diposting oleh di

Tidak ada komentar:

Posting Komentar

Langganan: Posting Komentar (Atom)