Question

到目前为止，我已经能够以编程方式附加文件：

Private Sub AttachmentFile()
Dim oLook As Object
Dim oMail As Object
Dim FD As Object
Dim vrtSelectedItem As Variant

Set oLook = CreateObject("Outlook.Application")
Set oMail = oLook.CreateItem(0)
Set FD = Excel.Application.FileDialog(3)

With oMail

    FD.AllowMultiSelect = True
    FD.Filters.Clear
    FD.Filters.Add "All Files", "*.*"
    FD.InitialFileName = "\\ad\dfs\Shared Data\"

    If FD.Show = True Then
        For Each vrtSelectedItem In FD.SelectedItems
        .Attachments.Add vrtSelectedItem
        Next
    End If
    .Display
    End With
    Set FD = Nothing
    Set oMail = Nothing
    Set oLook = Nothing
End Sub

现在已经创建了电子邮件，我可以从指定的文件夹中选择文件，我正在尝试更改邮件项目的附加文件的名称，同时替换{{1}带有_（管道符号）的（下划线）。

这是我现在正在使用的工作代码。我还在电子邮件中添加了一个签名，其中包含了Outlook中默认签名的正确字体和图像。

Answer 1

Private Sub SubNBodyNTo()
Dim myInspector As Outlook.Inspector
Dim MItem As MailItem
Dim myAttachments As Outlook.Attachments

Set myInspector = Application.ActiveInspector
If Not TypeName(myInspector) = "Nothing" Then
    If TypeName(myInspector.CurrentItem) = "MailItem" Then
        Set MItem = myInspector.CurrentItem
        Set myAttachments = MItem.Attachments
        MItem.Subject = myAttachments.Item(1).DisplayName

        MItem.Subject = Replace(MItem.Subject, "_", " | ")
        MItem..HTMLBody = MItem.Subject & " Is attached for your approval." 
& "<br>" & MItem.HTMLBody
        MItem.To = "person@email.com"
        MItem.CC = "OtherPeople@email.com"

    End If
End If
End Sub

将新邮件主题行更改为附加文件的名称

1 个答案: