Vba 将附件名称添加到邮件正文

我希望有人能帮我。几个月前，我能够为Outlook2003编写一个宏，将所有附件的文件名添加到电子邮件中，这是我工作中真正需要的

但是，如果我将默认编辑器切换为Word，宏甚至不会出现；我想它必须被并入Word的normal.dot或其他东西中。如果我从Word将其添加到VB中，我可以看到宏，但会出现各种错误

希望有人能为我指出正确的方向。我当前的宏在“普通”Outlook邮件（不是用Word Editor创建的邮件）中工作如下：

子名称（）
作为附件的Dim Atmt
Dim Mensaje作为Outlook.MailItem
像弦一样模糊的附属物
设置Mensaje=Application.ActiveInspector.CurrentItem
Mensaje.BodyFormat=olFormatHTML
i=0
副官=“”
对于Mensaje.附件中的每个Atmt
'如果Atmt.大小>5，则
Adjuntos=“**附加文件：”&Atmt.FileName&“
”&vbNewLine&Adjuntos
i=i+1
"完"
下一个Atmt
Adjuntos=“附加文件总数：”&i&“
”&Adjuntos&vbNewLine
Mensaje.HTMLBody=副词和Mensaje.HTMLBody
Set Mensaje=无
端接头

下面两个代码块之间的区别只是Outlook对象库的链接。在Outlook中，这不是必需的，但从Word中，您需要将库作为Word项目的引用，或者使用后期绑定（我在下面演示的方法）

后期绑定将Outlook库链接到代码/项目中的对象，在本例中为

OLK

，并允许您使用相关函数，而无需执行任何其他步骤/保存任何其他文件

链接库也应该起作用，但由于这不是一个普通的Word项目，您以后可以参考/为每封新电子邮件创建一个新的Word项目，我认为（尽管我没有测试）您需要将代码包括在

normal

模板中，这意味着，除非指定不同的模板，否则代码将在您创建的任何Word文档上可用

这可能是您想要做的，也可能不是您想要做的，但如果是这样，则只需将Outlook代码放入您的

Normal

模板中即可

---

从MS Outlook（首选方法） 当粘贴到OUTLOOK项目中时，即使使用WORD作为电子邮件编辑应用程序，也可以这样做：

Option Explicit 

Sub Names()

Dim Atmt As Attachment
Dim Mensaje As Outlook.MailItem
Dim Adjuntos As String
Dim Body As String
Dim i As Integer


Set Mensaje = Application.ActiveInspector.CurrentItem
Mensaje.BodyFormat = olFormatHTML

Body = Mensaje.HTMLBody

i = 0
Adjuntos = ""

For Each Atmt In Mensaje.Attachments
    'If Atmt.Size > 5 Then
    Adjuntos = Adjuntos & "** Attached file: <u> " & Atmt.FileName & " </u> <br>"
    i = i + 1
    'End If
Next Atmt

Adjuntos = "<u> <b> Total number of attached files: " & i & "</u></b> <br>" & Adjuntos

Mensaje.HTMLBody = Left(Body, InStr(Body, "</body>") - 1) & Adjuntos & Right(Body, Len(Body) - InStr(Body, "</body>") + 4)

Set Mensaje = Nothing

End Sub

---

非常感谢。这样，我就得到了一个编译错误：“找不到方法或数据成员。”关于ActiveInspector部件。@user1574581，我应该补充一下，这段代码是放在Outlook项目中的一个模块中的，而不是放在Word中的（即不是直接放在邮件消息中）。这有用吗？如果没有，应该有其他一些方法来避免这个错误。让我知道，我会相应地更新答案。问题是，在我的情况下，VB编辑器似乎打开了一个Word项目（因为我使用Word作为电子邮件编辑器）。谢谢again@Xyberg多莉，谢谢你的耽搁。。。打开Outlook，按-，然后在此处输入代码。完成后，运行宏。如果您试图从活动消息窗口触发此操作，则可以从word执行此操作，但过程稍微复杂一些。让我知道，我就可以开始引导你朝这个方向努力了！没问题！我没有特别的急事，我不想麻烦。我确实按照你刚才告诉我的方式输入了我在这里发布的第一个代码，如果我不使用Word作为电子邮件编辑器，这很好。当我确实使用Word作为编辑器时会出现问题，然后，当我按alt+F8从活动消息窗口运行宏时，我只会将宏输入Word的VB编辑器。

Option Explicit 

Sub Names()

Dim Atmt As Attachment
Dim Mensaje As Outlook.MailItem
Dim Adjuntos As String
Dim Body As String
Dim i As Integer


Set Mensaje = Application.ActiveInspector.CurrentItem
Mensaje.BodyFormat = olFormatHTML

Body = Mensaje.HTMLBody

i = 0
Adjuntos = ""

For Each Atmt In Mensaje.Attachments
    'If Atmt.Size > 5 Then
    Adjuntos = Adjuntos & "** Attached file: <u> " & Atmt.FileName & " </u> <br>"
    i = i + 1
    'End If
Next Atmt

Adjuntos = "<u> <b> Total number of attached files: " & i & "</u></b> <br>" & Adjuntos

Mensaje.HTMLBody = Left(Body, InStr(Body, "</body>") - 1) & Adjuntos & Right(Body, Len(Body) - InStr(Body, "</body>") + 4)

Set Mensaje = Nothing

End Sub

Sub Names()

Dim OLK As Object 'Oulook.Application
Dim Atmt As Object 'Attachment
Dim Mensaje As Object 'Outlook.MailItem
Dim Adjuntos As String
Dim Body As String
Dim i As Integer

Set OLK = CreateObject("Outlook.Application")
Set Mensaje = OLK.ActiveInspector.CurrentItem
Mensaje.BodyFormat = 2 'olFormatHTML

Body = Mensaje.HTMLBody

i = 0
Adjuntos = ""

For Each Atmt In Mensaje.Attachments
    'If Atmt.Size > 5 Then
    Adjuntos = Adjuntos & "** Attached file: <u> " & Atmt.FileName & " </u> <br>"
    i = i + 1
    'End If
Next Atmt

Adjuntos = "<u> <b> Total number of attached files: " & i & "</u></b> <br>" & Adjuntos

Mensaje.HTMLBody = Left(Body, InStr(Body, "</body>") - 1) & Adjuntos & Right(Body, Len(Body) - InStr(Body, "</body>") + 4)

Set OLK = Nothing
Set Mensaje = Nothing

End Sub