Question

我想写一些VBA代码，它会自动从RTF文档创建一个新的电子邮件。我使用以下程序： 1. Microsoft Word 2013 2. Microsoft Outlook 2013

除了如何将我复制的内容粘贴到电子邮件正文中之外，我设法做了我想做的一切。

我已经在网上搜索了如何做到这一点但是我没有找到任何简单的方法来做到这一点。此外，我发现的所有示例都与Microsoft Excel有关。我注意到使用Microsoft Word时存在差异。

以下是我写的代码：

Sub SendDocAsMail()

Dim oOutlookApp As Outlook.Application
Dim oItem As Outlook.MailItem
Dim TheUser As String
Dim Subject As String
Dim ClientRef As String
Dim Body As String
Dim Signature As String
Dim SigString As String
Dim i As Integer
Dim Pos As Integer
Dim myAttachments As Outlook.Attachments

TheUser = Environ("UserName")

On Error Resume Next

'Start Outlook if it isn't running
Set oOutlookApp = GetObject(, "Outlook.Application")
If Err <> 0 Then
    Set oOutlookApp = CreateObject("Outlook.Application")
End If

'Create a new message
Set oItem = oOutlookApp.CreateItem(olMailItem)

'Copy the open document to subject and body

'Change only Mysig.htm to the name of your signature
    SigString = Environ("appdata") & _
                "\Microsoft\Signatures\" & TheUser & ".htm"

Selection.MoveDown Unit:=wdLine, Count:=1, Extend:=wdExtend
Subject = Selection.Text
Subject = Left(Subject, Len(Subject) - 1)
ClientRef = Subject
ClientRef = Right(ClientRef, Len(ClientRef) - 1)
For i = 1 To Len(ClientRef)
    If Mid(ClientRef, i, 1) = "|" Then
        Pos = i
    End If
Next i
ClientRef = Left(ClientRef, Pos - 1)

Selection.Delete Unit:=wdCharacter, Count:=1
Selection.Delete Unit:=wdCharacter, Count:=1
Selection.EndKey Unit:=wdStory
Selection.TypeParagraph
Selection.TypeParagraph
Selection.InsertFile (SigString)

Selection.WholeStory
Selection.Copy

oItem.To = "xxxx@xxxx.co.il; xxxx@xxxx.co.il"
oItem.BCC = "xxxx@xxxx.co.uk"
oItem.Subject = Subject
'oItem.Body = 'NEED HELP
'Selection.PasteAndFormat (wdFormatOriginalFormatting)

oItem.Display

Set myAttachments = oItem.Attachments
'myAttachments.Add.PathName = "C:\Users\" & TheUser & "\Dropbox\PATENT\Bressler\" & ClientRef & "\"
'Clean up
'    Word.ActiveDocument.Close SaveChanges:=wdDoNotSaveChanges
'    Word.Application.Quit SaveChanges:=wdDoNotSaveChanges


End Sub

非常感谢使用原始格式粘贴复制文本的所有帮助。

Answer 1

获取MailItem检测器的句柄，该检查器具有.WordEditor（基本上是MS Word文档实例）

https://msdn.microsoft.com/en-us/library/office/ff868098.aspx

这应该可以解决问题：

oItem.To = "xxxx@bxxxx.co.il; xxxx@xxxx.co.il"
oItem.BCC = "xxxx@docs.xxxx.co.uk"
oItem.Subject = Subject
'oItem.Body = 'NEED HELP

Dim mailWord as Object 'WordEditor
oItem.Display
Set mailWord = oItem.GetInspector.WordEditor
mailWord.Range(0).PasteAndFormat (wdFormatOriginalFormatting)

<强>解释

解释相当简单。为了使用像PasteSpecial这样的方法，您需要使用具有该方法的对象。 MailItem类不直接具有此功能，但它确实包含Inspector.WordEditor这是一个单词文档 - 因此您在单词中使用的任何方法都应该可用于olItem.Inspector.WordEditor。< / p>

<强>后续：

我只想使用FileDialog选择要附加的文件，如下所示：

Dim filePicker As FileDialog
Dim fileName As Variant

Set filePicker = Application.FileDialog(msoFileDialogFilePicker)
filePicker.AllowMultiSelect = True

'### specify the folder default for the fileDialog object
filePicker.InitialFileName = "C:\Path\to\your\folder\" 
filePicker.Show

For Each fileName In filePicker.SelectedItems
    oItem.Attachments.Add (fileName)
Next

或者，这可能更简单，也可能更有问题，因为有时您将线程移交给另一个应用程序时会出现问题：

olItem.GetInspector.CommandBars.ExecuteMSO "AttachFile"

我更喜欢FileDialog方法，因为它可以让您更好地控制结果选择。

如何从Microsoft Word粘贴到Outlook

1 个答案: