Các bỏ hoặc ẩn hộp thoại Data Link Propeties khi gởi mail bằng VBA

[quocvietpm]

Chào mọi người, mình đang có vấn đề với đoạn code VBA gởi mail, attached này. Nó luôn hiện lên hộp thoại Data Link Properties

Bên dưới là đoạn Code, anh chị nào có cách ẩn hoặc bỏ nó được không. Mình kiếm khắp nơi nhưng chưa biết cách giải quyết.

Sub Send_Mail_To_HR()

Dim FileExtStr As String
Dim FileFormatNum As Long
Dim Sourcewb As Workbook
Dim Destwb As Workbook
Dim TempFilePath As String
Dim TempFileName As String
Dim OutApp As Object
Dim OutMail As Object
Dim Signature As String
Dim cont As String
Dim ct5 As String, ct6 As String, ct7 As String, ct8 As String
Dim i As Integer, n As Integer

Call Move_file_to_Reviewed_Folder

ct5 = Trim(Sheets("Note").Range("T6").value)
ct6 = Trim(Sheets("Note").Range("T7").value)
ct7 = Trim(Sheets("Note").Range("T8").value)
ct8 = Trim(Sheets("Note").Range("T9").value)

cont = ct5 & ct6 & ct7 & ct8
TempFilePath = "Z:\15 ASSEMBLY\10. SHARE FOLDER\3 Attendance\Reviewed_PDF_File"
Set OutApp = CreateObject("Outlook.Application")
Set OutMail = OutApp.CreateItem(olMailItem)
Set FSO = CreateObject("Scripting.FileSystemObject")
Set Folder = FSO.GetFolder(TempFilePath)
Set Files = Folder.Files

With Application
.ScreenUpdating = False
.EnableEvents = False
End With

With OutMail
.Display
End With
Signature = OutMail.HTMLBody

On Error Resume Next

With OutMail
.To = "thao.nguyen@thermxsvt.com"
.cc = "diem.nguyen@thermxsvt.com,xuancuong.nguyen@thermxsvt.com,nguyen.luong@thermxsvt.com,nam.mai@thermxsvt.com"
.Subject = Trim(Sheets("Note").Range("S4").value)
.BodyFormat = 2
.HTMLBody = cont & "</B> <BR><BR> Kindly find attachment of PTO request and Time confirmation of this time. <BR>" & _
"<BR>Should you have any questions, do not hestitate to contact me." & _
"</B>" & Signature

For Each File In Files
TempFileName = File.Name
Set wb = Workbooks.Open(TempFilePath & "\" & TempFileName)
.Attachments.Add wb.FullName
wb.Close False
Next
.Display
'.Send
End With

Call Move_file_to_HR_Folder

On Error GoTo 0

Set OutMail = Nothing
Set OutApp = Nothing

With Application
.ScreenUpdating = True
.EnableEvents = True
End With

MsgBox ("Send Mail to HR, Completed!")

End Sub

 

[quocvietpm]

Chào mọi người,

Có anh chị nào biết cái này không chỉ mình với.

Cảm ơn,