zackilicious
New Member
- Joined
- Oct 24, 2016
- Messages
- 7
I have this code:
Sub Send_Files()
'Working in Excel 2000-2016
Dim OutApp As Object
Dim OutMail As Object
Dim sh As Worksheet
Dim cell As Range
Dim FileCell As Range
Dim rng As Range
Dim noidung As String
With Application
.EnableEvents = False
.ScreenUpdating = False
End With
Set sh = Sheets("Sheet1")
Set OutApp = CreateObject("Outlook.Application")
Set OutMail = OutApp.CreateItem(olMailItem)
noidung = GetBoiler("D:\NOI DUNG.HTM")
On Error Resume Next
For Each cell In sh.Columns("A").Cells.SpecialCells(xlCellTypeConstants)
'Enter the path/file names in the E:Z column in each row
Set rng = sh.Cells(cell.Row, 1).Range("D1:Z1")
If cell.Value Like "?*@?*.?*" And _
Application.WorksheetFunction.CountA(rng) > 0 Then
Set OutMail = OutApp.CreateItem(0)
With OutMail
.to = cell.Value
.Subject = cell.Offset(0, 1).Value
.HTMLBody = cell.Offset(0, 2).Value & noidung
For Each FileCell In rng.SpecialCells(xlCellTypeConstants)
If Trim(FileCell) <> "" Then
If Dir(FileCell.Value) <> "" Then
.Attachments.Add FileCell.Value
End If
End If
Next FileCell
.Send 'Or use .Display
End With
Set OutMail = Nothing
End If
Next cell
Set OutApp = Nothing
With Application
.EnableEvents = True
.ScreenUpdating = True
End With
End Sub
Function GetBoiler(ByVal sFile As String) As String
'**** Kusleika
Dim fso As Object
Dim ts As Object
Set fso = CreateObject("Scripting.FileSystemObject")
Set ts = fso.GetFile(sFile).OpenAsTextStream(1, -2)
GetBoiler = ts.readall
ts.Close
End Function
____________________________
In " .HTMLBody = cell.Offset(0, 2).Value & noidung "
I would like "cell.Offset(0, 2).Value" to be bold out, how could I write that code.
Millions thanks for support
Sub Send_Files()
'Working in Excel 2000-2016
Dim OutApp As Object
Dim OutMail As Object
Dim sh As Worksheet
Dim cell As Range
Dim FileCell As Range
Dim rng As Range
Dim noidung As String
With Application
.EnableEvents = False
.ScreenUpdating = False
End With
Set sh = Sheets("Sheet1")
Set OutApp = CreateObject("Outlook.Application")
Set OutMail = OutApp.CreateItem(olMailItem)
noidung = GetBoiler("D:\NOI DUNG.HTM")
On Error Resume Next
For Each cell In sh.Columns("A").Cells.SpecialCells(xlCellTypeConstants)
'Enter the path/file names in the E:Z column in each row
Set rng = sh.Cells(cell.Row, 1).Range("D1:Z1")
If cell.Value Like "?*@?*.?*" And _
Application.WorksheetFunction.CountA(rng) > 0 Then
Set OutMail = OutApp.CreateItem(0)
With OutMail
.to = cell.Value
.Subject = cell.Offset(0, 1).Value
.HTMLBody = cell.Offset(0, 2).Value & noidung
For Each FileCell In rng.SpecialCells(xlCellTypeConstants)
If Trim(FileCell) <> "" Then
If Dir(FileCell.Value) <> "" Then
.Attachments.Add FileCell.Value
End If
End If
Next FileCell
.Send 'Or use .Display
End With
Set OutMail = Nothing
End If
Next cell
Set OutApp = Nothing
With Application
.EnableEvents = True
.ScreenUpdating = True
End With
End Sub
Function GetBoiler(ByVal sFile As String) As String
'**** Kusleika
Dim fso As Object
Dim ts As Object
Set fso = CreateObject("Scripting.FileSystemObject")
Set ts = fso.GetFile(sFile).OpenAsTextStream(1, -2)
GetBoiler = ts.readall
ts.Close
End Function
____________________________
In " .HTMLBody = cell.Offset(0, 2).Value & noidung "
I would like "cell.Offset(0, 2).Value" to be bold out, how could I write that code.
Millions thanks for support