Snasui Excel Forum

Code: Select all

Dim wb As Workbook
Dim fileExtension As String
Dim tempPath As String
Dim tempName As String

Code: Select all

Set wb = ThisWorkbook
fileExtension = VBA.Mid(wb.Name, InStr(1, wb.Name, ".xl"))
tempPath = VBA.Environ$("temp") & "\"
tempName = Replace(wb.Name, fileExtension, "") & " " & VBA.Format(Now, "dd-mmm-yy h-mm-ss")
wb.SaveCopyAs tempPath & tempName & fileExtension

Code: Select all

objMsg.AddAttachment tempPath & tempName & fileExtension

Code: Select all

Kill tempPath & tempName & fileExtension

Code: Select all

Sub Macro1()
' Object creation
Set objMsg = CreateObject("CDO.Message")
Set msgConf = CreateObject("CDO.Configuration")
  
' กำหนด Server Configuration
msgConf.Fields.Item("http://schemas.microsoft.com/cdo/configuration/sendusing") = 2
msgConf.Fields.Item("http://schemas.microsoft.com/cdo/configuration/smtpserver") = "smtp.gmail.com"
msgConf.Fields.Item("http://schemas.microsoft.com/cdo/configuration/smtpserverport") = 465
msgConf.Fields.Item("http://schemas.microsoft.com/cdo/configuration/smtpauthenticate") = 1
msgConf.Fields.Item("http://schemas.microsoft.com/cdo/configuration/sendusername") = "nutpochan1@gmail.com"
msgConf.Fields.Item("http://schemas.microsoft.com/cdo/configuration/sendpassword") = "**********"
msgConf.Fields.Item("http://schemas.microsoft.com/cdo/configuration/smtpusessl") = 1
msgConf.Fields.Update
'ประกาศตัวแปร
 Dim wb As Workbook
Dim fileExtension As String
Dim tempPath As String
Dim tempName As String

  'กำหนดค่า
  Set wb = ThisWorkbook
fileExtension = VBA.Mid(wb.Name, InStr(1, wb.Name, ".xl"))
tempPath = VBA.Environ$("temp") & "\"
tempName = Replace(wb.Name, fileExtension, "") & " " & VBA.Format(Now, "dd-mmm-yy h-mm-ss")
'Saveไฟล์
wb.SaveCopyAs tempPath & tempName & fileExtension


' ส่ง Email

objMsg.To = "nutpochan1@gmail.com"
objMsg.From = "nutpochan1@gmail.com"
objMsg.bodypart.Charset = "utf-8"
objMsg.Subject = Cells(1, 18).Value
objMsg.HTMLBody = Cells(2, 18).Value
objMsg.Sender = "weerfdgsdfg"
objMsg.AddAttachment tempPath & tempName & fileExtension
Set objMsg.Configuration = msgConf

'ลบไฟล์ทิ้งต้องเอาไว้หลัง คำสั่งแนบไฟล์
  Kill tempPath & tempName & fileExtension
' Send
objMsg.Send
  
' Clear
Set objMsg = Nothing
Set msgConf = Nothing
End Sub

Code: Select all

objMsg.HTMLBody = Range("w2") & "<br>" & "<a href=range(q1)>"