Question

免责声明：我也在其他专家论坛上发帖求助。希望这不是违反使用此论坛的行为。

我在办公室使用Macro，它使用六个可变行的连接，因为我想引入“Next Line”。然而，我发现的问题是，当执行代码以发送电子邮件时，电子邮件正文将丢失其所有格式并在电子邮件中使用简单的文本格式。

问题 - 我可以使用一个单元格，让我说A1并将我的邮件正文放在我希望的格式中，VBA可以拉动这个单元格“按原样”。 “这是关键”在这里。请帮忙。

我正在使用Lotus Notes，重现电子邮件的代码也列在下面

Private Sub CommandButton1_Click()
Dim userconfirmation As String

'User Intent validation
Line1:
 userconfirmation = MsgBox("Are you ready to send mails to 'ALL' Recievers Marked in this List." & vbNewLine & _
  " This action CANNOT be UNDONE.", vbYesNoCancel, "Confirmation")
If userconfirmation = vbNo Then
    MsgBox ("OK , I understand you are not ready now." & vbNewLine & "Prepare your data and come back ")
    Exit Sub
Else

If userconfirmation = vbYes Then

MsgBox ("Let's Proceed")
Else
MsgBox ("OK , I understand you are not ready now." & vbNewLine & "Prepare your data and come back ")
    Exit Sub

End If
End If

'Variables for Email
    Dim Subject As String
    Dim Attachment As String
    Dim Recipient As Variant
    Dim CCRecipient As Variant
    Dim BCCRecipient As Variant
    Dim BodyText As Variant
    Dim SaveIt As Boolean
    Dim Signature As Variant
    Dim Sender As Variant

'Body text Variant
    Dim Line_1 As Variant
    Dim Line_2 As Variant
    Dim Line_3 As Variant
    Dim Line_4 As Variant
    Dim Line_5 As Variant
    Dim Line_6 As Variant

    Dim startrow As Variant
    Dim ToCol As Variant
    Dim Cccol As Variant
    Dim bcccol As Variant
    Dim subjectcol As Variant
    Dim bodytextcol As Variant
    Dim Saluation As Variant

'Variable for database and Lotus Note Handling
    Dim Maildb As Object 'The mail database
    Dim UserName As String 'The current users notes name
    Dim MailDbName As String 'THe current users notes mail database name
    Dim MailDoc As Object 'The mail document itself
    Dim AttachME As Object 'The attachment richtextfile object
    Dim Session As Object 'The notes session
    Dim EmbedObj As Object 'The embedded object (Attachment)
    Dim NUIWorkspace As Object

'   Dim i As Double
    Dim jpassword As Variant


Sender = ActiveWorkbook.BuiltinDocumentProperties("Author")

    'Start a session to notes
'Line2:
'    jpassword = InputBox("Please provide your Lotus Notes Password")
'    If jpassword = "" Then
'    MsgBox (" Password cannot be blank")
'    GoTo Line2
'    End If

    Set Session = CreateObject("Notes.NotesSession")
'Next line only works with 5.x and above. Replace password with your password
'Session.Initialize (jpassword)
'Get the sessions username and then calculate the mail file name
'You may or may not need this as for MailDBname with some systems you
'can pass an empty string or using above password you can use other mailboxes.
    UserName = Session.UserName
    MailDbName = Left$(UserName, 1) & Right$(UserName, (Len(UserName) - InStr(1, UserName, " "))) & ".nsf"
'Open the mail database in notes
    Set Maildb = Session.GETDATABASE("", MailDbName)
     If Maildb.IsOpen = True Then
'Already open for mail
     Else
         Maildb.OPENMAIL
     End If

startrow = 3
ToCol = 4
Cccol = 5
bcccol = 6
subjectcol = 7
Saluation = 2
bodytextcol = 9
Line_1 = 10
Line_2 = 11
Line_3 = 12
Line_4 = 13
Line_5 = 14
Line_6 = 15

Do While Cells(startrow, ToCol).Value <> ""

    Recipient = Cells(startrow, ToCol)
    CCRecipient = Cells(startrow, Cccol)
    BCCRecipient = Cells(startrow, bcccol)
    Subject = Cells(startrow, subjectcol)
    Signature = "Regards," & vbNewLine & Sender

    If Cells(startrow, Saluation) <> "" Then

        BodyText = "Dear " & Cells(startrow, Saluation) & "," & _
                vbNewLine & Cells(startrow, Line_1) & _
                vbNewLine & Cells(startrow, Line_2) & _
                vbNewLine & Cells(startrow, Line_3) & _
                vbNewLine & Cells(startrow, Line_4) & _
                vbNewLine & Cells(startrow, Line_5) & _
                vbNewLine & Cells(startrow, Line_6) & _
                vbNewLine & vbNewLine & vbNewLine
                BodyText = BodyText & vbNewLine & Signature


    Else

        BodyText = "Hi " & " ," & _
        vbNewLine & Cells(startrow, Line_1) & _
        vbNewLine & Cells(startrow, Line_2) & _
        vbNewLine & Cells(startrow, Line_3) & _
        vbNewLine & Cells(startrow, Line_4) & _
        vbNewLine & Cells(startrow, Line_5) & _
        vbNewLine & Cells(startrow, Line_6) & _
        vbNewLine & vbNewLine & vbNewLine
        BodyText = BodyText & vbNewLine & Signature
    End If

'   MsgBox BodyText

'Set up the new mail document
        Set MailDoc = Maildb.CREATEDOCUMENT
        MailDoc.Form = "Memo"
        MailDoc.sendto = Recipient
        MailDoc.copyto = CCRecipient
        MailDoc.blindcopyto = BCCRecipient
        MailDoc.Subject = Subject
        MailDoc.body = BodyText
        MailDoc.SAVEMESSAGEONSEND = SaveIt
        MailDoc.SAVEMESSAGEONSEND = True
'Set up the embedded object and attachment and attach it
    If Attachment <> "" Then
        Set AttachME = MailDoc.CreateRichTextItem("Attachment")
        Set EmbedObj = AttachME.EMBEDOBJECT(1454, "", Attachment, "Attachment")
        MailDoc.CreateRichTextItem (Attachment)
    End If
'Send the document
    MailDoc.PostedDate = Now() 'Gets the mail to appear in the sent items folder
    'This line has been commented to avoid mail triffers. while testing , you need to open the same.

    MailDoc.SEND 0, Recipient
'Clean Up
    Set MailDoc = Nothing
    Set AttachME = Nothing
    Set Session = Nothing
    Set EmbedObj = Nothing
    startrow = startrow + 1
Loop
    Set Maildb = Nothing
    Set MailDoc = Nothing
    Set AttachME = Nothing
    Set Session = Nothing
    Set EmbedObj = Nothing
    MsgBox (startrow - 3 & " Mails Sent successfully")


End Sub

使用VBA发送邮件时保留电子邮件正文的文本格式

0 个答案: