Sai thuật toán code dò tìm đúng dòng thông tin gửi mail bằng VBA

[hic1802]

Chào mọi người trên GPE,
Nhờ mọi người trên diên đàn sửa giúp e code gửi mail trên excel bằng VBA, code này em xem ở trên Youtube
Hiện tại e chạy code này nó load toàn bộ các dòng để gửi, yêu cầu là chỉ chọn dòng đã được chon (dấu "x")

Public Function send_email()
Dim ir As Long
On Error Resume Next
ir = Sheet1.Cells(Sheet1.Rows.Count, "D").End(xlUp).Row
For i = 1 To ir
    If Sheet1.Cells("I" & i) = "x" Then
        esubject = Sheet1.Cells("D" & i).Value
        sendto = Sheet1.Cells("F" & i).Value
        ccto = Sheet1.Cells("G" & i).Value
        bccto = Sheet1.Cells("H" & i).Value
        ebody = ""
        newfilename = Sheet1.Cells("E" & i).Value
        Set app = CreateObject("Outlook.Application")
        Set itm = app.createitem(0)
        With itm
            .Subject = esubject
            .to = sendto
            .cc = ccto
            .bcc = bccto
            .body = ebody
            .attachments.Add (newfilename)
            .display
            .send
        End With
    Set app = Nothing
    Set itm = Nothing
    End If
Next i
End Function
Sub sendmail()
send_email
End Sub

em muốn nó chỉ gửi nội dung tại dòng mà e đánh dấu "x" ở cột I (gửi mail)
Nhờ mọi người giúp đỡ.

 

[befaint]

Bỏ dòng On Error Resume Next này đi là biết lỗi ở đâu liền à. Đây là ví dụ điển hình sự nguy hiểm của nó.

If Sheet1.Range("I" & i).Value = "x" Then

 

[hic1802]

Bỏ dòng On Error Resume Next này đi là biết lỗi ở đâu liền à. Đây là ví dụ điển hình sự nguy hiểm của nó.

If Sheet1.Range("I" & i).Value = "x" Then

chào bác cái VBA này e chưa rõ bản chất lắm, em có thử cách khác như thế này

Public Sub send_email()
Dim ir As Long, esubject As Variant, sendto As Variant, i As Long
Dim ccto As Variant, bccto As Variant, ebody As Variant, newfilename As Variant
'On Error Resume Next
ir = Sheet1.Cells(Sheet1.Rows.Count, "D").End(xlUp).Row
For i = 1 To ir
    If Sheet1.Cells(9, i) = "x" Then
        esubject = Sheet1.Cells("D", i).Value
        sendto = Sheet1.Cells("F", i).Value
        ccto = Sheet1.Cells("G", i).Value
        bccto = Sheet1.Cells("H", i).Value
        ebody = ""
        newfilename = Sheet1.Cells("E", i).Value
    End If
Next i
        Set app = CreateObject("Outlook.Application")
        Set itm = app.createitem(0)
        With itm
            .Subject = esubject
            .to = sendto
            .cc = ccto
            .bcc = bccto
            .body = ebody
            .attachments.Add (newfilename)
            .display
            .send
        End With
    Set app = Nothing
    Set itm = Nothing
End Sub

nó báo lỗi ở dòng .attachments.Add (newfilename)
hay là do em khai báo newfilename sai? nếu vậy phải khai báo nó ntn a?

 

[truongvu317]

Copy ở chỗ nào thì qua đó hỏi lad nhanh nhất. Lúc thì là function lúc là sub. Hình như phải là .add néwfile. Tức bỏ cái () đi. Chả rõ nữa

 

[befaint]

ntn

cddnca!!! Nhìn bài #2 mbc!!!!!!!!!!!!!!

If Sheet1.Cells(9, i) = "x" Then
esubject = Sheet1.Cells("D", i).Value
sendto = Sheet1.Cells("F", i).Value
ccto = Sheet1.Cells("G", i).Value
bccto = Sheet1.Cells("H", i).Value
ebody = ""
newfilename = Sheet1.Cells("E", i).Value

 

[VetMini]

cddnca!!! Nhìn bài #2 mbc!!!!!!!!!!!!!!

Hay! vqd c mtn

 

[batman1]

Sai cú pháp.

Sửa

If Sheet1.Cells("I" & i) = "x" Then

thành

If Sheet1.Cells(i, "I") = "x" Then

hoặc

If Sheet1.Cells(i, 9) = "x" Then

hoặc thành

If Sheet1.Range("I" & i) = "x" Then

Các nơi tiếp theo dạng Sheet1.Cells(...) sửa tương tự.

Hãy nhìn kỹ các dạng
-----
Nếu dùng If Sheet1.Cells(9, i) = "x" Then thì không sai cú pháp nhưng sai hướng vì code kiểm tra ô ở dòng 9 cột i. Đúng phải là: kiểm tra ô ở dòng i cột 9 (cột I)