如何在Excel / VBA中将工作表发送给自己(根据Outlook帐户打开动态更改电子邮件)

时间:2014-07-15 12:12:39

标签: vba excel-vba outlook excel

现在我有一个带有一些VBA的工作簿,当按下按钮时,它会通过电子邮件发送给一个用户(电子邮件地址是硬编码的)。它很棒。但是,我想知道是否有可能" cc"向按下按钮发送电子邮件的用户发送电子邮件。它可能来自10-15个不同的人。

现在,以下代码将发送电子邮件至" orders@myemail.com"表格的副本名为"打印",并且在收件箱中它来自正确的用户。不知怎的,它能够点击用户的电子邮件并自动发送给他们,所以我认为必须有一种方法让他们自己CC。

所有电子邮件帐户都将在Microsoft Oulook上。

以下是通过电子邮件发送给一个人的代码(我是从http://www.rondebruin.nl/win/s1/outlook/amail2.htm获得的):

  'Sub that emails the 3rd sheet in the body of an email
    Sub Mail_Sheet_Outlook_Body()
    Call UnProtect
    Application.ReferenceStyle = xlA1

    'RangetoHTML function is copied in the module after this sub.

        Dim rng As Range
        Dim OutApp As Object
        Dim OutMail As Object

        With Application
            .EnableEvents = False
            .ScreenUpdating = False
        End With

        Set rng = Nothing

        Set rng = Sheets("Print").UsedRange

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

        On Error Resume Next

            With OutMail
                .To = "orders@myemail.com" 
                .CC = ""                              
                .BCC = ""
                .Subject = "New Order from Employee"
                .HTMLBody = RangetoHTML(rng)   
                .Send   'or use .Display
             End With 
    On Error GoTo 0

    With Application
        .EnableEvents = True
        .ScreenUpdating = True
    End With

    Set OutMail = Nothing
    Set OutApp = Nothing
    Call Protect
    End Sub

所以重申一下我要问的是,无论如何,当user1@email.com发送订单/发送电子邮件时,它会自动发送给自己,以及何时发送给自己user2@email.com做同样的事情只有cc自己。根据谁的帐户打开工作簿进行动态更改。

2 个答案:

答案 0 :(得分:4)

尝试使用application.Session.CurrentUser.Address获取电子邮件ID

Sub EmailWithCCTome()
Dim outlookobj As Object
Dim emailitem As Object
Set outlookobj = CreateObject("Outlook.Application")
Set emailitem = outlookobj.CreateItem(olMailItem)
With emailitem
.To = toemail
.CC = outlookobj.Session.CurrentUser.Address
End With

答案 1 :(得分:0)

您必须以某种方式编程以捕获您想要在工作表/表单上的某个位置cc的电子邮件地址,并将其存储为字符串变量(或将.Value引用直接传递给.CC字段)和/或使用工作表参考。类似的东西:

   Sub Mail_Sheet_Outlook_Body()
    Call UnProtect
    Application.ReferenceStyle = xlA1

    'RangetoHTML function is copied in the module after this sub.

        Dim rng As Range
        Dim OutApp As Object
        Dim OutMail As Object
        **Dim ccEmail As String**

{your code here}

       ccEmail = Sheet1.Range("A1").Value ' or where ever you capture the email

{more of your code here}

            With OutMail
                .To = "orders@myemail.com" 
                **.CC = ccEmail**
{rest of your code}

没有可靠的方法让Excel / VBA知道电子邮件地址而无法捕获它。