Добавление подписи электронной почты по умолчанию через письмо, написанное в макросе, в Outlook - PullRequest
Новая
       4

Добавление подписи электронной почты по умолчанию через письмо, написанное в макросе, в Outlook

0 голосов
/ 15 мая 2018

Я пытаюсь написать макрос в outlook, который, когда я нажимаю кнопку «Новая почта», запрашивает вложение.Когда я выбираю вложение, оно затем читает его имя и помещает это имя в тему и тело.

В настоящее время я могу выполнить указанные выше задачи, с некоторыми незначительными проблемами, которые янадеясь, что смогу получить помощь.На данный момент, когда мне предлагают вложение, я выбираю его, но затем оно требует от меня сделать это во второй раз.Затем он будет использовать это второе вложение только для информации и фактического вложения в электронное письмо.Моя вторая проблема заключается в том, что я не могу понять, как заставить электронное письмо добавить подпись по умолчанию в конце, когда оно пишет макрос.

Я никогда не работал с VBA до пятницы, и очень мало опыта программированияНадеюсь, кто-нибудь может помочь.Я скопировал часть кода из другого места, а затем построил на нем, так что я знаю, что это может быть не совсем чистый код. 

Sub CreateNewMail()
Dim obApp As Object
Dim NewMail As MailItem
Dim otherObject As Word.Application
Dim fd As Office.FileDialog
Dim fileaddress As String
Dim filename As String
Dim signature As String

Set obApp = Outlook.Application
Set NewMail = obApp.CreateItem(olMailItem)


'Set to use Word for Attach File Dialog
Set otherObject = New Word.Application
otherObject.Visible = False

Set fd = otherObject.Application.FileDialog(msoFileDialogFilePicker)

With fd
.AllowMultiSelect = False
.InitialFileName = "\\atro1\users\tdomanski\scan"
.Show
End With

fd.Show

fileaddress = fd.SelectedItems(1)

'Aquire File Name in correct form for Subject Line
Dim MidStart As Long
MidStart = InStrRev(fileaddress, "\") + 1

Dim MidEnd As Long
MidEnd = InStrRev(fileaddress, ".")

filename = Mid(fileaddress, MidStart, MidEnd - MidStart)



htmlbody1 = "<HTML><Body><p>Good Afternoon,</p><p>Please confirm receipt of attached "
htmlbody2 = "<br/>Please either email an order acknowledgement to me or initial & fax back PO to 716-655-0309.<p>Also, we are striving for 100% on-time delivery of purchase orders.  If you cannot meet the required delivery date on the PO, please contact me as soon as possible.</p><p>Thank you!</p></body></html>"

'You can change the concrete info as per your needs
With NewMail
     .Subject = filename
     .BodyFormat = olFormatHTML
     .HTMLBody = (htmlbody1 + filename + htmlbody2)
     .Attachments.Add ((fileaddress))
     .Display
End With
signature = oMail.HTMLBody
Set obApp = Nothing
Set NewMail = Nothing

End Sub

1 Ответ

0 голосов
/ 15 мая 2018

Добавление подписи по умолчанию к почте немного сложно.Однажды я хотел сделать это, но не смог найти легкого решения.Поэтому я придумал обходной путь для достижения этой цели.Первая процедура - это создание и сохранение почты в черновой папке.В этом письме нет Body, поэтому он каким-то образом добавляет подпись по умолчанию, если она существует. 

Public Sub SendAnEmail()
Dim Poczta As New Outlook.Application
Dim mojMail As MailItem
Dim Subj As String

Subj = "Test"

Set Poczta = CreateObject("outlook.application")
Set mojMail = Poczta.CreateItem(0)
    With mojMail
        .To = "ddddd@www.com"
        .Subject = Subj
        .ReadReceiptRequested = False
        .OriginatorDeliveryReportRequested = False
        '.Body = sign
        .Display
        '.Send
        .Save

    End With

End Sub

Затем в каждом цикле мы читаем письма из черновиков и соединительных строк.Первая строка - это тело письма, которое в данный момент считается вашей подписью, и вы можете связать это с чем угодно. 

Sub Drafts()

Dim DraftFold As Outlook.Folder
Dim item As MailItem
Dim sign As String

Set DraftFold = 
Application.GetNamespace("MAPI").GetDefaultFolder(olFolderDrafts)

For Each item In DraftFold.Items
    sign = item.Body
Next item

Dim Poczta As New Outlook.Application
Dim mojMail As MailItem

Dim Subj As String
Dim Text As String


Subj = "Test"

Text = "Anything"

Set Poczta = CreateObject("outlook.application")
Set mojMail = Poczta.CreateItem(0)
    With mojMail
        .To = "ddddd@www.com"
        .Subject = Subj
        .ReadReceiptRequested = False
        .OriginatorDeliveryReportRequested = False
        .Body = sign
        .Display
        '.Send

    End With

End Sub

Ну, я знаю, что это не очень хорошее решение, но если вы не будетенайди лучше попробуй с этим поработать.

Добро пожаловать на сайт PullRequest, где вы можете задавать вопросы и получать ответы от других членов сообщества.

Нет похожих вопросов

...