Sub SendMail()
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)
OutMail.Display
Signature = OutMail.HTMLBody
On Error Resume Next
With OutMail
.To = vTo
.CC = vCC
.BCC = ""
.Subject = vSject
'.HTMLBody = body & Signature
Body = "<p style='font-family:Arial;font-size:14'>" & vDoc1 & "<BR><BR>" & vDoc2 & "<BR><BR>" & vDoc3
.HTMLBody = Body & Signature
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 ("Da gui")
End Sub