Snasui Excel Forum

Code: Select all

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

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

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

' 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
  'send mutiplier email
 
' Email

objMsg.To = "nutpochan1@gmail.com,nutpochan@hotmail.com"
objMsg.From = "nutpochan1@gmail.com"
objMsg.bodypart.Charset = "utf-8"
objMsg.Subject = Cells(1, 1).Value
objMsg.HTMLBody = Cells(2, 1).Value
objMsg.Sender = "weerfdgsdfg"
objMsg.AddAttachment "C:\Users\โฮม\Desktop\dfdfงาน1.xlsm"
Set objMsg.Configuration = msgConf
  
' Send
objMsg.Send
  
' Clear
Set objMsg = Nothing
Set msgConf = Nothing

Code: Select all

Sub CDO_Mail_With_Gmail()
    Dim iMsg As Object
    Dim iConf As Object
    Dim strbody As String
    Dim Flds As Variant
    Const gmailUser As String = "YourEmail" '1
    Const gmailPassword As String = "YourPassword" '2
    Const strUrl = "http://schemas.microsoft.com/cdo/configuration/"
    
    Set iMsg = CreateObject("CDO.Message")
    Set iConf = CreateObject("CDO.Configuration")

    iConf.Load -1
    Set Flds = iConf.Fields
    With Flds
        .Item(strUrl & "smtpusessl") = True
        .Item(strUrl & "smtpauthenticate") = 1
        .Item(strUrl & "sendusername") = gmailUser
        .Item(strUrl & "sendpassword") = gmailPassword
        .Item(strUrl & "smtpserver") = "smtp.gmail.com"
        .Item(strUrl & "sendusing") = 2
        .Item(strUrl & "smtpserverport") = 465
        .Update
    End With

    strbody = "Hello"

    With iMsg
        Set .Configuration = iConf
        .To = "EmailAddressOfRecipient" '3
        .CC = ""
        .BCC = ""
        .From = """YourName"" <YourEmail>" '4
        .Subject = "Important message"
        .TextBody = strbody
        .Send
    End With

End Sub