Appendix Thread 2. ( Codes for other Threads, HTML Tables, etc.)

[DocAElstein]

Code in code tags from here:
http://www.excelfox.com/forum/showth...0699#post10699

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

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