ผมพยายามใช้ vba ส่ง hotmail แต่ล้มเหลวครับ

[nutpochan]

ผมพยายามใช้ vba ส่ง hotmail จากโค๊ดก็คือ ขออนุญาติโพสโค๊ดครับ

Code: Select all

Sub SendEmail_Outlook()
    Const myEmailAddress = "nutpochan@hotmail.com"
    Const myEmailPassword = "ขอเก็บเป็นความลับ"
    
    
    With CreateObject("CDO.message")
    
        With .Configuration.Fields
            .Item("http://schemas.microsoft.com/cdo/configuration/sendusing") = 2
            .Item("http://schemas.microsoft.com/cdo/configuration/smtpserver") = "smtp-mail.outlook.com"
           .Item("http://schemas.microsoft.com/cdo/configuration/smptserverport") = 421
            .Item("http://schemas.microsoft.com/cdo/configuration/smtpauthenticate") = 1
            .Item("http://schemas.microsoft.com/cdo/configuration/smtpusessl") = True
            .Item("http://schemas.microsoft.com/cdo/configuration/smtpconnectiontimeout") = 60
            .Item("http://schemas.microsoft.com/cdo/configuration/sendusername") = myEmailAddress
            .Item("http://schemas.microsoft.com/cdo/configuration/sendpassword") = myEmailPassword
            .Update
        End With

        .To = "nutpochan@hotmail.com"
        .From = myEmailAddress
        .Subject = "subject"
        .TextBody = "the body"
        .Send
    End With
End Sub

แต่ผลที่ออกมาเป็นเหมือนในรูปภาพที่ผมแนบมาด้วย พร้อมกับไฟล์ excell VBA ที่ผมแนบมาครับ

อยากทราบว่าผมควรแก้ไขโค๊ดตรงส่วนไหนครับ

[nutpochan]

รูปภาพข้อผิดพลาดที่เด้งขึ้นมาคืออันนี้นะครับ

http://www.mx7.com/view2/yLCg3wkzbrKd01gI

[snasui]

การแนบภาพแนบไฟล์ให้แนบมาในฟอรัมนี้ ตัดเฉพาะกรอบที่แสดงปัญหา ภาพจะได้ไม่เกิน 800*600 ครับ

ตัวอย่าง Code การส่งอีเมลทาง Hotmail ครับ

Code: Select all

Sub SendMailByHotmail()
    Const myEmailAddress = "abcdef@hotmail.com"
    Const myEmailPassword = "xxyyzz"
    
    With CreateObject("CDO.message")
    
        With .Configuration.Fields
            .Item("http://schemas.microsoft.com/cdo/configuration/sendusing") = 2
            .Item("http://schemas.microsoft.com/cdo/configuration/smtpserver") = "smtp.live.com"
            .Item("http://schemas.microsoft.com/cdo/configuration/smptserverport") = 465
            .Item("http://schemas.microsoft.com/cdo/configuration/smtpauthenticate") = 1
            .Item("http://schemas.microsoft.com/cdo/configuration/smtpusessl") = True
            .Item("http://schemas.microsoft.com/cdo/configuration/smtpconnectiontimeout") = 60
            .Item("http://schemas.microsoft.com/cdo/configuration/sendusername") = myEmailAddress
            .Item("http://schemas.microsoft.com/cdo/configuration/sendpassword") = myEmailPassword
            .Update
        End With

        .To = "ghijkl@gmail.com"
        .From = myEmailAddress
        .Subject = "subject"
        .TextBody = "the body"
        .Send
    End With
End Sub

[nutpochan]

ผมได้นำโค๊ดที่อาจารย์ให้ไปใช้ แล้วยังติดเหมือนเดิมตามรูป ที่แนบมาครับ ผมต้องไปตั้งค่าตรงไหนก่อนหรือเปล่า

[nutpochan]

ตอนที่ผมเอาไปใช้ผมเปลี่ยนแปลงแค่ 3ที่คือ

Code: Select all

   Const myEmailAddress = "nutpochan@hotmail.com"
    Const myEmailPassword = "***********"
    
            .To = "nutpochan@hotmail.com"

หรือผมต้องเปลี่ยนที่อื่นในโค๊ดด้วยครับ

[snasui]

ถ้า Copy ที่ผมเขียนไปใช้ จะเปลี่ยนแค่ 3 ที่และต้องต่อ Internet ครับ

ในเครื่องผมสามารถส่งอีเมลได้ปกติ ไม่มีปัญหาใดครับ

[nutpochan]

หรือผมต้องลง ซอฟแวร์ตัวไหนเพิ่มเติม ครับ

[snasui]

อ่านที่ผมเขียนไปด้านบน ผมเพิ่มข้อความที่ต้องสังเกตเพิ่มเติมไว้แล้ว เพราะดูเหมือนว่าไม่ได้ copy ที่ผมเขียนไปใช้ครับ

[nutpochan]

ผม ก็อปปี้ ตามโค๊ดของอาจารย์ทั้งหมดนั้นแหละครับ เพียงแต่ ตัวหนังสือสีเขียวผมเปลี่ยนแปลงเป็นอีเมลของผม

Code: Select all

Sub SendMailByHotmail()
  [color=#80FF40]  Const myEmailAddress = "abcdef@hotmail.com"
    Const myEmailPassword = "xxyyzz"[/color]
    
    With CreateObject("CDO.message")
    
        With .Configuration.Fields
            .Item("http://schemas.microsoft.com/cdo/configuration/sendusing") = 2
            .Item("http://schemas.microsoft.com/cdo/configuration/smtpserver") = "smtp.live.com"
            .Item("http://schemas.microsoft.com/cdo/configuration/smptserverport") = 465
            .Item("http://schemas.microsoft.com/cdo/configuration/smtpauthenticate") = 1
            .Item("http://schemas.microsoft.com/cdo/configuration/smtpusessl") = True
            .Item("http://schemas.microsoft.com/cdo/configuration/smtpconnectiontimeout") = 60
            .Item("http://schemas.microsoft.com/cdo/configuration/sendusername") = myEmailAddress
            .Item("http://schemas.microsoft.com/cdo/configuration/sendpassword") = myEmailPassword
            .Update
        End With

        .To = [color=#80FF00]"ghijkl@gmail.com"[/color]
        .From = myEmailAddress
        .Subject = "subject"
        .TextBody = "the body"
        .Send
    End With
End Sub

แต่เมื่อผมกดrunแล้ว มันยังเป็นdebug เหมือนกับไฟล์แนบมาครับ

[snasui]

ภาพ Error เล็กมาก ไม่สามารถอ่านได้ครับ

ศึกษาการกำหนดค่าเพิ่มเติมที่ Ron เขียนไว้ จาก Link นี้ครับ http://www.rondebruin.nl/win/s1/cdo.htm

[nutpochan]

แก้ภาพeror มาใหม่ให้ใหญ่กว่าเดิมแล้วครับ

[snasui]

ตรงบรรทัด .Item("http://schemas.microsoft.com/cdo/configuration/smptserverport") = 465 ลองเปลี่ยนจาก 465 เป็น 25 ดูครับ หากยังไม่ได้ก็ช่วยไม่ได้เช่นกัน เพราะในเครื่องผมทำงานด้วย Code ที่ผมตอบไปก่อนหน้านี้ได้ปกติครับ

[nutpochan]

อาจารย์ใช้ excell 2000 อะไรตอรรันหรอครับ

ก่อนผมรันผมต้องเข้า microsoft outlookก่อนไหม

[snasui]

ผมใช้ Excel 2010, 2013, 2016

เท่าที่จำได้น่าจะเป็น Version 2013 และไม่จำเป็นต้องใช้ Outlook ครับ

ด้านล่างเป็นตัวอย่างสำหรับการส่งอีเมลผ่าน Gmail ผม Run ด้วย Excel 2010 แล้วพบว่าสามารถทำงานได้ปกติครับ

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

[nutpochan]

ตรงที่ บทความของ ron

Set iMsg = CreateObject("CDO.Message")
Set iConf = CreateObject("CDO.Configuration")

"CDO.Message" จะใส่เป็น email ของเรา หรือไม่ต้องเปลี่ยน

"CDO.Configuration" จะใส่เป็น password ของเราหรือไม่ต้องเปลี่ยนครับ

[snasui]

ดูตัวอย่างการใช้งานที่ผมโพสต์ไปด้านบน

ของ Ron จะบอกไว้ชัดเจนแล้วว่าตรงไหนต้องเปลี่ยนหรือไม่เปลี่ยนครับ

[nutpochan]

อั๊ยยะ ดีใจมากรู้วิธีแก้แล้วครับ แชร์ให้คนที่ไม่รู้
ให้เครดิตกระทู้นี้หน่อยเป็นประโยชน์มาก https://community.qlik.com/thread/25067

คือว่าพ้อยมันอยู่ที่ถ้าโค๊ดเขียนถูกทุกอย่าง แต่ในบัญชีผู้ใช้ไม่อนุญาติแอปที่มีความปลอดภัยน้อย ก็ส่งไม่ได้ก็เด้ง

ดังนั้นเหมือนเขียนโค็ดถูกแล้วใคร มีปัญญา โค๊ด eror แบบนี้
The message could not be sent to the SMTP server. The transport error code was 0x80040217. The server response was not available

อย่าลืมไปตั้งค่าเปิดที่ https://www.google.com/settings/security/lesssecureapps นะครับ

[nutpochan]

จากโค๊ดที่แนบมา ถ้าเราอยากให้แนบไฟล์ซึ่งผมเขียนเป็น "C:\Users\โฮม\Desktop\dfdfงาน1.xlsm" แต่ทีนี้ผมอยากให้แนบไฟล์ที่เป็น workbook ปัจจุบันที่ผมใช้งานอยู่ ผมต้องแก้โค๊ดเป็นยังไงครับ โดยเราไม่ต้องมานั่งพิมที่อยู่โค๊ดที่อยู่ไฟล์ใหม่ทุกวัน โดยให้มันอ่านที่อยู่ไฟล์เอง

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

[snasui]

ตัวอย่างการปรับ Code ครับ

จาก objMsg.AddAttachment "C:\Users\โฮม\Desktop\dfdfงาน1.xlsm" เป็น objMsg.AddAttachment activeworkbook.Path &"\" & activeworkbook.name

[nutpochan]

แก้แล้ว debug ดังไฟล์แนบครับ