รบกวนสอบถามเรื่องส่ง Email ผ่าน Excel หน่อยครับ

[akung]

ตอนนี้ผมสามารถทำให้ส่งได้แล้ว (ไปลอกเขามา) แต่แค่รายเดียว และพยายามทำให้ส่งทีเดียวหลาย ๆ ราย แต่ยังทำไม่ได้ รบกวนช่วยดู Code ให้ด้วยครับ ขอบคุณครับ

[bank9597]

ไม่เคยทำเรื่องนี้มาก่อนเลยครับ เลยช่วยเหลืออะไรไม่ได้เลย

[snasui]

ลองปรับ Code เป็นตามด้านล่างเพื่อให้ทำการ Loop ส่งเมลทุกรายการครับ

Code: Select all

Private Sub CommandButton2_Click()
    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
    
    l = Sheets("Sheet1").Range("A" & Rows.Count).End(xlUp).Row
    Set rAll = Sheets("Sheet1").Range("A2:A" & l)

    Set OutlookApp = CreateObject("Outlook.Application")

    For Each r In rAll
        email_ = r '¼ÙéÃѺ
        s_email_ = r.Offset(0, 1) '¼ÙéÊè§
        subject_ = r.Offset(0, 2) ' àÃ×èͧ
        body_ = r.Offset(0, 3).Value ' ÃÒÂÅÐàÍÕ´ Email
        
        Set MItem = OutlookApp.CreateItem(0)
        With MItem
            .SentOnBehalfOfName = s_email_
            .To = email_
            .Subject = subject_
            .Body = body_ & Chr(13) & Chr(13) & Chr(13) & r.Offset(0, 4) _
                & Chr(13) & r.Offset(0, 5) & Chr(13) & r.Offset(0, 6) & Chr(13) & r.Offset(0, 7)
            .send
        End With
    Next r
    OutlookApp = Nothing
    MItem = Nothing
End Sub

[akung]

ตอนนี้ทดสอบแล้ว ติดปัญหาตรงที่กดปุ่ม ตามรูปทุกครั้งที่ส่งเลยครับ ไม่ทราบพอจะมีทางแก้ไขไหมครับ ขอบคุณครับ

[snasui]

ปัญหาเดียวกับกระทู้นี้ http://www.snasui.com/viewtopic.php?f=3&t=2426 สำหรับเครื่องผมไม่มีปัญหาเช่นว่านั้น ลองทดสอบ Code ของ Ron หรือ Code อื่น ๆ ใน Internet ดูครับ ติดตรงไหนก็ถามกันมาได้เรื่อย ๆ ครับ

[akung]

ปัญหาเดียวกับกระทู้นี้ http://www.snasui.com/viewtopic.php?f=3&t=2426 สำหรับเครื่องผมไม่มีปัญหาเช่นว่านั้น ลองทดสอบ Code ของ Ron หรือ Code อื่น ๆ ใน Internet ดูครับ ติดตรงไหนก็ถามกันมาได้เรื่อย ๆ ครับ

ผมใช้วิธี Application.DisplayAlerts = False ก็ยังไ่ด้ครับ พอจะมีวิธีอื่นไหมครับ

Code: Select all

Private Sub CommandButton2_Click()
    Application.DisplayAlerts = False
    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
    
    l = Sheets("Sheet1").Range("A" & Rows.Count).End(xlUp).Row
    Set rAll = Sheets("Sheet1").Range("A2:A" & l)

    Set OutlookApp = CreateObject("Outlook.Application")

    For Each r In rAll
        email_ = r '¼ÙéÃѺ
        s_email_ = r.Offset(0, 1) '¼ÙéÊè§
        subject_ = r.Offset(0, 2) 'àÃ×èͧ
        body_ = r.Offset(0, 3).Value 'ÃÒÂÅÐàÍÕ´ Email
        
        Set MItem = OutlookApp.CreateItem(0)
        With MItem
            .SentOnBehalfOfName = s_email_
            .To = email_
            .Subject = subject_
            .Body = body_ & Chr(13) & Chr(13) & Chr(13) & r.Offset(0, 4) _
                & Chr(13) & r.Offset(0, 5) & Chr(13) & r.Offset(0, 6) & Chr(13) & r.Offset(0, 7)
            .send
        End With
    Next r
    OutlookApp = Nothing
    MItem = Nothing
    Application.DisplayAlerts = True
End Sub

[snasui]

ลองทดสอบ Code ของ Ron ตาม Link นี้ครับ Using VBA send email

[akung]

ลองทดสอบ Code ของ Ron ตาม Link นี้ครับ Using VBA send email

http://www.add-in-express.com/docs/outl ... tomate.php

ผมไปเจอเวปนี้มาครับ ผมก็ลองใช้สูตรนี้แล้ว ก็ติด Error ครับ คิดว่าน่าจะต้องปรับแต่งที่ Excel ตรงไหนด้วยสักอย่าง

Code: Select all

Private Sub CommandButton2_Click()
    
    
    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
    
    OlSecurityManager.ConnectTo OutlookApp 'Runtime Eror 424 ตรงนี้ครับ
 
    OlSecurityManager.DisableOOMWarnings = True
 
    On Error GoTo Finally
       
    l = Sheets("Sheet1").Range("A" & Rows.Count).End(xlUp).Row
    Set rAll = Sheets("Sheet1").Range("A2:A" & l)

    Set OutlookApp = CreateObject("Outlook.Application")

    For Each r In rAll
        email_ = r '¼ÙéÃѺ
        s_email_ = r.Offset(0, 1) '¼ÙéÊè§
        subject_ = r.Offset(0, 2) 'àÃ×èͧ
        body_ = r.Offset(0, 3).Value 'ÃÒÂÅÐàÍÕ´ Email
        
        Set MItem = OutlookApp.CreateItem(0)
        With MItem
            .SentOnBehalfOfName = s_email_
            .To = email_
            .Subject = subject_
            .Body = body_ & Chr(13) & Chr(13) & Chr(13) & r.Offset(0, 4) _
                & Chr(13) & r.Offset(0, 5) & Chr(13) & r.Offset(0, 6) & Chr(13) & r.Offset(0, 7)
            .send
        End With
    Next r
    OutlookApp = Nothing
    MItem = Nothing
    
Finally:
    
    OlSecurityManager.DisableOOMWarnings = False

End Sub

[snasui]

สำหรับ Link add-ins express ที่แนบมา ผมอ่านผ่าน ๆ เป็นการเขียน Code เพื่อทำเป็น Add-ins ด้วย Visual Studio แล้วค่อยนำมาทำเป็นไฟล์ Add-ins ซึ่งจะต้องติดตั้ง Add-ins ลงไปในเครื่องก่อนแล้วค่อยใช้งานและสามารถปลด Security Warning ได้

ลองทดสอบ Code ด้านล่างซึ่งผมปรับใหม่โดยไม่ต้อง Create Object ของ Outlook ขึ้นมาก่อน

Code: Select all

Option Explicit

Private Sub CommandButton2_Click()
    Dim OutlookApp As Outlook.Application
    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

    l = Sheets("Sheet1").Range("A" & Rows.Count).End(xlUp).Row
    Set rAll = Sheets("Sheet1").Range("A2:A" & l)

    Set OutlookApp = Outlook.Application

    For Each r In rAll
        email_ = r
        s_email_ = r.Offset(0, 1)
        subject_ = r.Offset(0, 2)
        body_ = r.Offset(0, 3).Value
        
        Set MItem = OutlookApp.CreateItem(0)
        With MItem
            .SentOnBehalfOfName = s_email_
            .To = email_
            .Subject = subject_
            .Body = body_ & Chr(13) & Chr(13) & Chr(13) & r.Offset(0, 4) _
                & Chr(13) & r.Offset(0, 5) & Chr(13) & r.Offset(0, 6) & Chr(13) & r.Offset(0, 7)
            .send
        End With
    Next r
    
End Sub

สำหรับการโพสต์ Code VBA ควรทำให้เป็น Code เพื่อจะได้ง่ายต่อการอ่านและ Copy ไปทดสอบ ดูวิธีการที่นี่ครับ viewtopic.php?f=6&t=1187

[akung]

สำหรับ Link add-ins express ที่แนบมา ผมอ่านผ่าน ๆ เป็นการเขียน Code เพื่อทำเป็น Add-ins ด้วย Visual Studio แล้วค่อยนำมาทำเป็นไฟล์ Add-ins ซึ่งจะต้องติดตั้ง Add-ins ลงไปในเครื่องก่อนแล้วค่อยใช้งานและสามารถปลด Security Warning ได้

ลองทดสอบ Code ด้านล่างซึ่งผมปรับใหม่โดยไม่ต้อง Create Object ของ Outlook ขึ้นมาก่อน

Code: Select all

Option Explicit

Private Sub CommandButton2_Click()
    Dim OutlookApp As Outlook.Application
    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

    l = Sheets("Sheet1").Range("A" & Rows.Count).End(xlUp).Row
    Set rAll = Sheets("Sheet1").Range("A2:A" & l)

    Set OutlookApp = Outlook.Application

    For Each r In rAll
        email_ = r
        s_email_ = r.Offset(0, 1)
        subject_ = r.Offset(0, 2)
        body_ = r.Offset(0, 3).Value
        
        Set MItem = OutlookApp.CreateItem(0)
        With MItem
            .SentOnBehalfOfName = s_email_
            .To = email_
            .Subject = subject_
            .Body = body_ & Chr(13) & Chr(13) & Chr(13) & r.Offset(0, 4) _
                & Chr(13) & r.Offset(0, 5) & Chr(13) & r.Offset(0, 6) & Chr(13) & r.Offset(0, 7)
            .send
        End With
    Next r
    
End Sub

สำหรับการโพสต์ Code VBA ควรทำให้เป็น Code เพื่อจะได้ง่ายต่อการอ่านและ Copy ไปทดสอบ ดูวิธีการที่นี่ครับ viewtopic.php?f=6&t=1187

ขอบคุณครับ และต้องขออภัยเรื่องการโพสต์ด้วยครับ ครั้งหน้าผมจะดำเนินการให้ถูกต้องครับ ขอบคุณอีกครั้งครับ

[akung]

run แล้วติด ตามภาพเลยครับ ต้องไป Tools > Reference ตัวไหนหรือเปล่าครับ ขอบคุณครับ

[snasui]

ลอง Add Reference ของ Microsoft Outlook 12.0 Object Library ดูครับ

[akung]

ลอง Add Reference ของ Microsoft Outlook 12.0 Object Library ดูครับ

ผมใช้ version 2003 มีแต่ Microsoft Outlook 11.0 Object Library ครับ พอ Add แล้ว Error ตามรูปครับ รบกวนด้วยครับ ขอบคุณครับ

[snasui]

เนื่องจากที่เครื่องผมไม่มีปัญหาเลยไม่สามารถเปลี่ยน Code แล้วทดสอบให้ได้

ลองปรับ Code จาก Outlook.Application เป็น Outlook.Application.11 ดูว่าสามารถทำงานได้หรือไม่ครับ

[akung]

เนื่องจากที่เครื่องผมไม่มีปัญหาเลยไม่สามารถเปลี่ยน Code แล้วทดสอบให้ได้

ลองปรับ Code จาก Outlook.Application เป็น Outlook.Application.11 ดูว่าสามารถทำงานได้หรือไม่ครับ

ลองใส่ .11 แล้ว error ครับ

ผมพยายามหาทาง Register แต่ไม่รู้ Regis ยังไง น่าจะเป็นตรงจุดนี้มากกว่า

[snasui]

ปกติการ Register จะทำเมื่อมีการเพิ่ม Control อื่น ๆ เข้ามาใช้ ยกตัวอย่างเช่นตามกระทู้นี้ http://www.snasui.com/viewtopic.php?f=3&t=2420 สำหรับการส่งเมลเราไม่่ได้เพิ่ม Control ใด ๆ เข้ามาช่วยแต่สามารถเขียน Code อ้างถึง Object ที่มีอยู่แล้วมาใช้งาน

สำหรับ Version 2003 ผมเข้าใจว่าโปรแกรมไม่รู้จัก Object ตัวนั้น จึงฟ้องในลักษณะดังกล่าว ทางเลือกอื่น ๆ เพื่อเลี่ยง Object model guard security prompts คือไปกำหนด Macro Security ใน Outlook 2003 ให้เป็น Low หรือเปลี่ยนเป็น Code ของ Ron ตาม Link นี้ครับ http://www.rondebruin.nl/cdo.htm

[akung]

ปกติการ Register จะทำเมื่อมีการเพิ่ม Control อื่น ๆ เข้ามาใช้ ยกตัวอย่างเช่นตามกระทู้นี้ http://www.snasui.com/viewtopic.php?f=3&t=2420 สำหรับการส่งเมลเราไม่่ได้เพิ่ม Control ใด ๆ เข้ามาช่วยแต่สามารถเขียน Code อ้างถึง Object ที่มีอยู่แล้วมาใช้งาน

สำหรับ Version 2003 ผมเข้าใจว่าโปรแกรมไม่รู้จัก Object ตัวนั้น จึงฟ้องในลักษณะดังกล่าว ทางเลือกอื่น ๆ เพื่อเลี่ยง Object model guard security prompts คือไปกำหนด Macro Security ใน Outlook 2003 ให้เป็น Low หรือเปลี่ยนเป็น Code ของ Ron ตาม Link นี้ครับ http://www.rondebruin.nl/cdo.htm

ขอบคุณครับ ผมนำโปรแกรมไปลองกับ Excel 2007 ก็รันได้ไม่มีปัญหาครับ แต่ผมจะลองศึกว่าวิธีการของ Ron ดูครับ ขอบคุณมากครับ