Snasui Excel Forum

Set OutlookApp = Nothing
Set MItem = Nothing

:D สองบรรทัดนั้นเอาไว้คืน Memory ให้กับระบบ จะต้องมีคำว่า [c]set[/c] นำหน้าด้วย คือเขียนเป็น

[code]Set OutlookApp = Nothing
Set MItem = Nothing[/code]

จึงจะใช้ได้ครับ

เรียน คุณ Snasui จากการนำ Code ที่คุณ Snasui แนะนำ สามารถใช้งานได้ครับ
แต่ติดที่ 2 Code นี้ครับ ที่ Run แล้วมีการเตือน และส่งอีเมล์ผ่านครับ ดังนั้นผมจึงเอาออกไป และเมื่อกดทดสอบส่งเมล์อีกครั้ง ก็สามารถ Run ผ่านและก็ส่งอีเมล์ได้ปกติครับ จึงไม่แน่ใจว่า 2 Code นี้ไว้ทำอะไรครับ
'OutlookApp = Nothing
'MItem = Nothing
ขอบพระคุณเป็นอย่างสูงครับ

Sub Email2()
    Dim OutlookApp As Object
    Dim MItem As Object
    Dim email_ As String
    Dim s_email_ As String
    Dim subject_ As String
    Dim body_ As String
    Dim rAll As Range
    Dim r As Range
    Dim l As Long
    Dim sh As Worksheet
    
    Set sh = Worksheets("Email")
    l = sh.Range("A" & Rows.Count).End(xlUp).Row
    Set rAll = sh.Range("A2:A" & l - 1)

    Set OutlookApp = CreateObject("Outlook.Application")
   
    Set MItem = OutlookApp.CreateItem(0)
    
    With MItem
        .SentOnBehalfOfName = sh.Range("b2").Value
        .To = VBA.Join(Application.Transpose(rAll), ";")
        .Subject = sh.Range("d2").Value
        .Body = body_ & Chr(13) & sh.Range("E2") & sh.Range("F2") & Chr(13) & _
            sh.Range("G2") & Chr(13) & sh.Range("H2") & Chr(13) & sh.Range("I2") & _
            sh.Range("J2") & Chr(13) & sh.Range("K2") & Chr(13) & sh.Range("L2") & _
            Chr(13) & sh.Range("M2") & Chr(13) & sh.Range("N2") & Chr(13) & _
            sh.Range("O2") & Chr(13) & sh.Range("P2") & Chr(13) & sh.Range("Q2") & _
            Chr(13) & sh.Range("R2") & Chr(13) & sh.Range("S2") & Chr(13) & _
            sh.Range("T2") & Chr(13) & sh.Range("U2") & Chr(13) & sh.Range("V2") & _
            Chr(13) & sh.Range("W2") & Chr(13) & sh.Range("X2") & Chr(13) & _
            sh.Range("Y2") & Chr(13) & sh.Range("Z2")
        .send
    End With

    OutlookApp = Nothing
    MItem = Nothing
    
End Sub

:D การส่งหลายคนแสดงว่าต้องเป็นหัวเรื่องเดียวกัน ไฟล์แนบเหมือนกัน เพียงแต่ผู้รับมีหลายคน

ีควรปรับ Code จาก Loop เป็นแบบอื่น ถ้าต้อง Loop ก็เพียง Loop เพื่อจะสร้างผู้รับเป็น 1 ตัวแปร โดยตัวแปรนั้นคืออีเมลของผู้รับทุกคนครับ

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

[code]
Sub Email2()
Dim OutlookApp As Object
Dim MItem As Object
Dim email_ As String
Dim s_email_ As String
Dim subject_ As String
Dim body_ As String
Dim rAll As Range
Dim r As Range
Dim l As Long
Dim sh As Worksheet

Set sh = Worksheets("Email")
l = sh.Range("A" & Rows.Count).End(xlUp).Row
Set rAll = sh.Range("A2:A" & l - 1)

Set OutlookApp = CreateObject("Outlook.Application")

Set MItem = OutlookApp.CreateItem(0)

With MItem
.SentOnBehalfOfName = sh.Range("b2").Value
.To = VBA.Join(Application.Transpose(rAll), ";")
.Subject = sh.Range("d2").Value
.Body = body_ & Chr(13) & sh.Range("E2") & sh.Range("F2") & Chr(13) & _
sh.Range("G2") & Chr(13) & sh.Range("H2") & Chr(13) & sh.Range("I2") & _
sh.Range("J2") & Chr(13) & sh.Range("K2") & Chr(13) & sh.Range("L2") & _
Chr(13) & sh.Range("M2") & Chr(13) & sh.Range("N2") & Chr(13) & _
sh.Range("O2") & Chr(13) & sh.Range("P2") & Chr(13) & sh.Range("Q2") & _
Chr(13) & sh.Range("R2") & Chr(13) & sh.Range("S2") & Chr(13) & _
sh.Range("T2") & Chr(13) & sh.Range("U2") & Chr(13) & sh.Range("V2") & _
Chr(13) & sh.Range("W2") & Chr(13) & sh.Range("X2") & Chr(13) & _
sh.Range("Y2") & Chr(13) & sh.Range("Z2")
.send
End With

OutlookApp = Nothing
MItem = Nothing

End Sub
[/code]

เรียนทุกท่านที่เคารพครับ เนื่องจากผมได้นำไฟล์การส่งอีเมล์ตามโพสในกลุ่มนี้มาศึกษาและดัดแปลงเพื่อมาประยุกต์ใช้งานในการส่งอีเมล์ ซึ่งกรณีที่ส่งอีเมล์ไปหาคนเดียว ปุ่มที่ได้ทำสามารถใช้งานได้ปกติ แต่พอทำปุ่มเพื่อใช้อีก Code VB ที่เป็นการส่งหลายๆคน เช่น ส่ง 3 คน ต้องส่ง ถึง 3 อีเมล์ และพอ Run แล้วขึ้น Error ครับ แต่ระบบส่งเมล์ไปได้ปกติ 3 อีเมล์ และอยากทราบวิธีในการส่งแค่อีเมล์เดียวแต่ไปถึง 3-20 คนได้ จะต้องทำอย่างไรครับ ผมแนบไฟล์ทดสอบมาด้วยครับ ขอบคุณมากๆครับ