删除签名在通过Excel VBA宏生成的Outlook 2010消息中 [英] Deleting Signature In Outlook 2010 message generated via Excel VBA macro

问题描述

我一直在尝试阅读，但是找不到此问题的解决方案。
我有一个excel文件，当用户按下一个按钮时：

A）选择范围并复制到剪贴板

B）基于模板打开一个新的外观消息

C）电子邮件将代表发送，而不是用户名/ acount

然后，用户必须在电子邮件中添加日期并将复制的范围粘贴到模板的某个部分。
这一切都可以，工作，但是！ outlook会自动将用户的签名添加到电子邮件的末尾，这是不需要的。

这是我目前使用的代码：

  Sub SelectArea（）
 Application.ScreenUpdating = False 
 
 lastCol = ActiveSheet.Range（a1） .End（xlToRight）.Column  -  2 
 lastRow = ActiveSheet.Cells（500，lastCol）.End（xlUp）.Row 
 ActiveSheet.Range（a1，ActiveSheet.Cells（lastRow，lastCol） ）.Copy 
 
 Dim OutApp作为Outlook.Application 
 Dim OutMail As Outlook.MailItem 
 
设置OutApp = CreateObject（Outlook.Application）
 Set OutMail = OutApp.CreateItemFromTemplate（\\\\
etwork\path\to\the\MailTemplate.oft）
 
带OutMail 
 .SentOnBehalfOfName =DepartmentX < [e-mail]> 
。显示
结束
 
 Application.ScreenUpdating = True 
 End Sub 
  

目前没有deletesignature sub，因为我无法让它工作。
它曾经在使用OutMail内，但子本身不起作用。
我甚至测试了Microsoft站点1：1中的示例，但仍然无法使其正常工作。

Microsoft的代码如下： p>

  Sub TestDeleteSig（）
 Dim objOL As Outlook.Application 
 Dim objMsg As Outlook.MailItem 
设置objOL = CreateObject（Outlook.Application）
设置objMsg = objOL.CreateItem（olMailItem）
 objMsg.Display 
调用DeleteSig（objMsg）
设置objMsg = Nothing 
 End Sub 
 
 Sub DeleteSig（msg As Outlook.MailItem）
 Dim objDoc As Word.Document 
 Dim objBkm As Word.Bookmark 
 On Error Resume Next 
设置objDoc = msg.GetInspector.WordEditor 
设置objBkm = objDoc.Bookmarks（_ MailAutoSig）
如果不是objBkm Is Nothing然后
 objBkm.Select 
 objDoc.Windows （1）.Selection.Delete 
 End If 
 Set objDoc = Nothing 
 Set objBkm = Nothing 
 End Sub 
  

它打开一个新的e -mailmessage（带签名）并给出编译错误。
未定义用户定义类型。它以黄色标记Sub DeleteSig（msg As Outlook.MailItem），并以蓝色突出显示objDoc As Word.Documen。
...那就是它丢失了我的地方：（

这里有人可能对此有所了解吗？

请问。

解决方案

这将从电子邮件模板中删除签名

最后一个子将将Excel中的选定范围放入模板正文中

  Option Explicit 
 
 Public Sub TestDeleteSig（）
 Dim olApp As Object，olMsg As Object 
 
设置olApp = CreateObject（Outlook.Application）
设置olMsg = olApp.CreateItem（0）
 olMsg.Display 
 
 DeleteSig olMsg 
 InsertRng olMsg 
 
设置olMsg = Nothing 
 End Sub 
 
 Private Sub DeleteSig（作为对象）
 Dim wrdDoc As Object，wrdBkm As Object 
 On Error Resume Next 
设置wrdDoc = msg.GetInspector。 WordEditor 
设置wrdBkm = wrdDoc.Bookmarks（_ MailAutoSig）
如果不是wrdBkm Is Nothin g然后wrdBkm.Range.Delete 
设置wrdDoc = Nothing 
设置wrdBkm = Nothing 
 End Sub 
 
 Private Sub InsertRng（作为对象的msg）
 Dim rng As Range 
设置rng = Selection.SpecialCells（xlCellTypeVisible）
如果不是rng不是然后
如果rng.Rows.Count = 1然后rng.Columns.Count = 1然后
如果Len（rng）= 0然后设置rng = ActiveSheet.UsedRange.Cells（1）
结束如果
 rng.Copy 
 msg.GetInspector.WordEditor.Content.PasteSpecial xlPasteAll 
 Application.CutCopyMode = False 
如果
 End Sub 
  

如果只有一个单元被选中且为空，它将粘贴来自ActiveSheet

的数据的第一个单元格

I've been trying and reading around but I can't find the solution for this problem. I have an excel file where when the user presses a button:

A) a range is selected and copied to the clipboard

B) A new outlook messages opens based on a template

C) E-mail will be sent "on behalf" off instead of the users' name/acount

The user then has to add a date in the e-mail and paste the copied range into a certain part of the template. This is all ok and working BUT!!! outlook automatically adds the users' signature to the end of the e-mail and that is unwanted.

This is the code I'm currently using:

Sub SelectArea()
Application.ScreenUpdating = False

lastCol = ActiveSheet.Range("a1").End(xlToRight).Column - 2
lastRow = ActiveSheet.Cells(500, lastCol).End(xlUp).Row
ActiveSheet.Range("a1", ActiveSheet.Cells(lastRow, lastCol)).Copy

Dim OutApp As Outlook.Application
Dim OutMail As Outlook.MailItem

Set OutApp = CreateObject("Outlook.Application")
Set OutMail = OutApp.CreateItemFromTemplate("\\network\path\to\the\MailTemplate.oft")

With OutMail
    .SentOnBehalfOfName = """DepartmentX"" <[e-mail]>"
    .Display
End With

Application.ScreenUpdating = True
End Sub

Currently there is no deletesignature sub, because I couldn't get it to work. It used to be inside "with OutMail" but the sub itself did not work. I even tested the example from the Microsoft site 1:1 but still could not get it to work.

The code from Microsoft is as follows:

Sub TestDeleteSig()
    Dim objOL As Outlook.Application
    Dim objMsg As Outlook.MailItem
    Set objOL = CreateObject("Outlook.Application")
    Set objMsg = objOL.CreateItem(olMailItem)
    objMsg.Display
    Call DeleteSig(objMsg)
    Set objMsg = Nothing
End Sub

Sub DeleteSig(msg As Outlook.MailItem)
    Dim objDoc As Word.Document
    Dim objBkm As Word.Bookmark
    On Error Resume Next
    Set objDoc = msg.GetInspector.WordEditor
    Set objBkm = objDoc.Bookmarks("_MailAutoSig")
    If Not objBkm Is Nothing Then
        objBkm.Select
        objDoc.Windows(1).Selection.Delete
    End If
    Set objDoc = Nothing
    Set objBkm = Nothing
End Sub

It opens a new e-mailmessage (with signature) and gives a compile error. "User-defined type not defined". It marks "Sub DeleteSig(msg As Outlook.MailItem)" in yellow and highlights "objDoc As Word.Documen" in blue. ... and that's where it loses me :(

Can someone here perhaps shed some light on this? It would be much appreciated.

Kind regards.

解决方案

This will remove the signature from an email template

The last Sub will place a selected range from Excel into the body of the template

Option Explicit

Public Sub TestDeleteSig()
    Dim olApp As Object, olMsg As Object

    Set olApp = CreateObject("Outlook.Application")
    Set olMsg = olApp.CreateItem(0)
    olMsg.Display

    DeleteSig olMsg
    InsertRng olMsg

    Set olMsg = Nothing
End Sub

Private Sub DeleteSig(msg As Object)
    Dim wrdDoc As Object, wrdBkm As Object
    On Error Resume Next
    Set wrdDoc = msg.GetInspector.WordEditor
    Set wrdBkm = wrdDoc.Bookmarks("_MailAutoSig")
    If Not wrdBkm Is Nothing Then wrdBkm.Range.Delete
    Set wrdDoc = Nothing
    Set wrdBkm = Nothing
End Sub

Private Sub InsertRng(msg As Object)
    Dim rng As Range
    Set rng = Selection.SpecialCells(xlCellTypeVisible)
    If Not rng Is Nothing Then
        If rng.Rows.Count = 1 And rng.Columns.Count = 1 Then
            If Len(rng) = 0 Then Set rng = ActiveSheet.UsedRange.Cells(1)
        End If
        rng.Copy
        msg.GetInspector.WordEditor.Content.PasteSpecial xlPasteAll
        Application.CutCopyMode = False
    End If
End Sub

If only one cell is selected and is empty, it will paste the first cell with data from ActiveSheet

这篇关于删除签名在通过Excel VBA宏生成的Outlook 2010消息中的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持IT屋！