Chào bạn,
Tôi đang sử dụng mã VBA của bạn: Gửi hàng loạt email được cá nhân hóa đến một danh sách từ Excel nhưng tôi có thêm 2 câu hỏi cho một codechange:
- Làm thế nào tôi có thể thêm chữ ký chuẩn trong thư?
- Làm cách nào để thêm tệp đính kèm cố định vào một thư mục?

Ai đó có thể giúp tôi thay đổi mã không?
Cảm ơn rất nhiều
Trân trọng
Bart

#If VBA7 And Win64 Then

    Private Declare PtrSafe Function ShellExecute Lib "shell32.dll" Alias "ShellExecuteA" ( _

                         ByVal hwnd As LongPtr, ByVal lpOperation As String, _

                         ByVal lpFile As String, ByVal lpParameters As String, ByVal lpDirectory As String, _

                         ByVal nShowCmd As Long) As LongPtr

#Else

    Private Declare Function ShellExecute Lib "shell32.dll" Alias "ShellExecuteA" ( _

                         ByVal hwnd As Long, ByVal lpOperation As String, _

                         ByVal lpFile As String, ByVal lpParameters As String, ByVal lpDirectory As String, _

                         ByVal nShowCmd As Long) As Long

#End If

Sub SendEMail()

'update by Extendoffice 20160506

    Dim xEmail As String

    Dim xSubj As String

    Dim xMsg As String

    Dim xURL As String

    Dim i As Integer

    Dim k As Double

    Dim xCell As Range

    Dim xRg As Range

    Dim xTxt As String

    On Error Resume Next

    xTxt = ActiveWindow.RangeSelection.Address

    Set xRg = Application.InputBox("Please select the data range:", "Kutools for Excel", xTxt, , , , , 8)

    If xRg Is Nothing Then Exit Sub

    If xRg.Columns.Count <> 3 Then

        MsgBox " Regional format error, please check", , "Kutools for Excel"

        Exit Sub

    End If

    For i = 1 To xRg.Rows.Count

'       Get the email address

        xEmail = xRg.Cells(i, 2)

'       Message subject

        xSubj = "Your Registration Code"

'       Compose the message

        xMsg = ""

        xMsg = xMsg & "Dear " & xRg.Cells(i, 1) & "," & vbCrLf & vbCrLf

        xMsg = xMsg & " This is your Registration Code "

        xMsg = xMsg & xRg.Cells(i, 3).Text & "." & vbCrLf & vbCrLf

        xMsg = xMsg & " please try it, and glad to get your feedback! " & vbCrLf

        xMsg = xMsg & "Skyyang"

'       Replace spaces with %20 (hex)

        xSubj = Application.WorksheetFunction.Substitute(xSubj, " ", "%20")

        xMsg = Application.WorksheetFunction.Substitute(xMsg, " ", "%20")

'       Replace carriage returns with %0D%0A (hex)

        xMsg = Application.WorksheetFunction.Substitute(xMsg, vbCrLf, "%0D%0A")

'       Create the URL

        xURL = "mailto:" & xEmail & "?subject=" & xSubj & "&body=" & xMsg

'       Execute the URL (start the email client)

        ShellExecute 0&, vbNullString, xURL, vbNullString, vbNullString, vbNormalFocus

'       Wait two seconds before sending keystrokes

        Application.Wait (Now + TimeValue("0:00:02"))

        Application.SendKeys "%s"

    Next

End Sub