Snasui Excel Forum

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: 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

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

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