Nhờ sửa code VBA thêm chữ ký

[saobekhonglac]

Chào Anh/Chị.

Nhờ Anh.Chị sữa giúp em code bên dưới sau cho giữa dòng vDoc2 và vDoc3 cách nhau 2 dòng (tức vDoc2 enter 2 lần rồi mới tới vDoc3) và thêm chữ ký của mail giúp (chữ ký cũng cách vDoc3 2 dòng.

Sub TestMail()
Dim wb As Workbook
Dim OutApp As Object, OutMail As Object
Dim cn As Object
Dim fso, folder, file, files
Dim strPath As String

lastrow1 = Sheets(1).Range("B" & Rows.Count).End(xlUp).Row
For i = 2 To lastrow1
vTo = Sheets(1).Cells(i, 2)
vCC = Sheets(1).Cells(i, 3)
vPath = Sheets(1).Cells(i, 4)
vFiles = Sheets(1).Cells(i, 5)
vSject = Sheets(1).Cells(i, 6)
vDoc1 = Sheets(1).Cells(i, 7)
vDoc2 = Sheets(1).Cells(i, 8)
vDoc3 = Sheets(1).Cells(i, 9)

Set cn = CreateObject("ADODB.connection")
strPath = vPath
Set fso = CreateObject("Scripting.FileSystemObject")
Set folder = fso.GetFolder(strPath)
Set files = folder.files


With Application
.ScreenUpdating = False
.EnableEvents = False
End With
Set OutApp = CreateObject("Outlook.Application")
Set OutMail = OutApp.CreateItem(0)
On Error Resume Next
With OutMail
.To = vTo
.CC = vCC
.BCC = ""
.Subject = vSject

.Body = vDoc1 & vbNewLine & vbNewLine & _
vDoc2 & _
vbNewLine & _
vDoc3
If vFiles = "" Then
For Each file In files
vName = file.Name
Set wb = Workbooks.Open(strPath & "\" & vName)
.Attachments.Add wb.FullName
wb.Close

Next
Else
Set wb = Workbooks.Open(strPath & "\" & vFiles)
.Attachments.Add wb.FullName
wb.Close
End If
.send 'or use .Display send
'.Display send
End With
Set OutMail = Nothing
Set OutApp = Nothing

With Application
.ScreenUpdating = True
.EnableEvents = True
End With
Next i
MsgBox ("Xong phim")

End Sub