Code in code tags from here:
http://www.excelfox.com/forum/showth...0699#post10699
Code:
Dim OutApp As Object
Dim OutMail As Object
Dim fileName As String
Dim mSubject As String
Dim signature As String
Dim fname As String
Dim mBody As String
Dim rng As Range
Dim rng1 As Range
Dim ws As Worksheet
Dim mailTo As String
fname = ws.Range("A1")
mSubject = "Equipment" & " For " & Range("A1").Value
Set OutApp = CreateObject("Outlook.Application")
Set OutMail = OutApp.CreateItem(0)
'mBody = "Z:\2\Form\\Manufacturing Order.xlsm"
Dim Path As String
ws.Protect ("Equipment")
Path = "\\Equipment- Maint RecordsThai1.xlsm"
mBody = "<font size=""3"" face=""Calibri"">" & _
"Dear Team,<br><br>" & _
"Please open the file from below link and change the date on the respective cell after you completed your task.<br><B>" & _
fileName & ".xlsm" & "</B> is created.<br>" & _
"Click on this link to open the file : " & _
"<A HREF=""file://" & Path & fileName & ".xlsm" & _
""">Files are saved here</A>" & "-->" & Range("A1").Value & _
"<br><br>Best Regards," & _
"<br><br></font>"
With OutMail
.display
End With
signature = OutMail.body
With Application
.EnableEvents = False
.ScreenUpdating = False
End With
Code:
Private Sub cmdNot_Click()
If Application.UserName = "Thai Nguyen" Then
Dim ws As Worksheet: Set ws = Sheets("Name")
Dim rng As Range, rng1 As Range
Dim fileName As String, fname As String
Let fname = ws.Range("B4")
Let mSubject = "Name"
Dim OutApp As Object, OutMail As Object
Set OutApp = CreateObject("Outlook.Application")
Set OutMail = OutApp.CreateItem(0)
Dim Subject As String, signature As String, mBody As String, mailTo As String
'mBody = "copy you link path in here"
Let mBody = "<font size=""3"" face=""Calibri"">" & _
"Hi Team,<br><br>" & _
"Please open the file from below link and put your signature on the respective cell after you completed your task.<br><B>" & _
ActiveWorkbook.Name & "</B> is created.<br>" & _
"Click on this link to open the file : " & _
"<A HREF=""file://" & ActiveWorkbook.FullName & """>Link to the file</A>" & _
"<br><br>Regards," & _
"<br><br>Thai Nguyen</font> "
OutMail.display
Let signature = OutMail.body
With Application
.EnableEvents = False
.ScreenUpdating = False
End With
With OutMail
'.To = "email"
If ws.Range("EU16") = True Then
Let mailTo = mailTo + "Thai Nguyen;"
Else
End If
If ws.Range("EU17") = True Then
mailTo = mailTo + "email"
End If
If ws.Range("EU18") = True Then
Let mailTo = mailTo + "email"
End If
If ws.Range("EU19") = True Then
Let mailTo = mailTo + "email"
End If
.To = mailTo
.CC = "Thai Nguyen"
.BCC = ""
.Subject = mSubject
'.body = "Hi Team," & vbCrLf & vbCrLf & "Please open the file from below link and put your signature on the respective cell and save the sheet"
'.htmlbody = RangetoHTML(rng)
.htmlbody = mBody
'.Attachments.Add fileName
.display
End With
'ws.PageSetup.RightHeader = "&""Calibri,italic""&11& " & ws.Range("A1")
ws.Protect ("Name")
ActiveWorkbook.Save
ActiveWorkbook.Close
On Error GoTo 0
Set OutMail = Nothing
Set OutApp = Nothing
With Application
.ScreenUpdating = True
.EnableEvents = True
End With
Else
MsgBox "You are not authorised to send BOM form, please check with BOM owner"
End If
End Sub
)
Reply With Quote
Bookmarks