Gửi email tính lương cho từng người

[zine]

Hi các anh chị
Em có bảng tính lương cho tất cả CBCNV trong công ty
Bây giờ em muốn sau khi tính lương, gửi cách tính lương chi tiết của từng người cho người đó qua email.(thông tin lương của người nào, chỉ người đó biết)
Em gửi kèm file, mọi người có cách gì giúp em nhé, đa tạ.

 

[Hai Lúa Miền Tây]

Em chào bác Hai Lúa,

Em muốn hỏi chút. Em làm theo file gửi nhiều mail mà bác gửi, khi gửi cho nhiều email có địa chỉ khác nhau thì okie. Nhưng nếu em chỉ gửi cho 1 địa chỉ email duy nhất (mặc dù nội dung các cột khác nhau) thì nó lại chỉ gửi đúng 1 email ở dòng đầu tiên. Làm thế nào để khắc phục bác nhỉ.

Em cảm ơn bác.

Họ tên	Địa chỉ Email	Hệ số chức danh	Số ngày công	Lương CD	Phụ cấp điện thoai	Phụ cấp đoàn thể	Trừ BHXH, BHTY	Lương CK	ĐIỀU KIỆN GỬI MAIL
Lê Phát Đởm​	abc@gmail.com​	4​	22​	6,000,000​	300,000​	100,000​	(245,000)​	6,155,000​	yes​
Lê Phát Đởm​	abc@gmail.com​	4​	21​	5,000,000​	200,000​	-​	(245,000)​	4,955,000​
Đởm Lê Phát​	abc@gmail.com​	4​	20​	5,500,000​	200,000​	100,000​	(245,000)​	5,555,000​	yes​
Phát Lê Đởm​	abc@gmail.com​	4​	20​	5,500,000​	200,000​	100,000​	(245,000)​	5,555,000​

Chào bạn,
Bạn tìm đọc trong chủ đề này sẽ có cái bạn cần nhé,
HLMT

 

[dnanh1988]

Chào bạn,
Bạn tìm đọc trong chủ đề này sẽ có cái bạn cần nhé,
HLMT

Cảm ơn bác. Em đã làm được.

Tuy nhiên em có câu hỏi thêm là, em dùng bảng này để gửi mail --> từ đó sẽ tạo yêu cầu tự động trên hệ thống --> tuy nhiên đối với ký tự đặc biệt như "/" "@" "&" thì lại không nhận. Trong khi nếu em tạo mail thông thường thì các ký tự này lại nhận. Vậy trong phần code có phải sửa thêm gì nữa không bác?

 

[infogated]

Anh @Hai Lúa Miền Tây Có Thể Giúp Em Phần Này Được Không Ạ? Sau Khi E Chạy Code Gửi Mail Tự Động Thì Máy Báo Lỗi Như Thế Này, Hiện Em Không Biết Làm Sao Để Sửa, Mong Được Anh Giúp, Cám Ơn Anh

 

[quyenpv]

Dear các anh
Nhờ anh giúp em file gửi email cảnh báo tiến độ công việc hết hạn và sắp hết hạn với ạ. Nội dung Body email và file đính kèm email như thế này ạ

No	NGÀY BĐ	Trọng số CV	MÔ TẢ	NHÓM	THỜI HẠN	K.L Giao	K.L H.Thành	% H.Thành	KẾT QUẢ	Số ngày
A	CÔNG VIỆC QUÁ HẠN​
1	01/04/2020​	4	Ngầm theo KPI (CT chính - ĐVT: tuyến) + Long Hải: 140503-BQLDA/VTNet-Long Hải/XL 2019​	HCQT​	20/04/2020​	3​	2​	67%​		-5​
2	01/04/2020​	4	Cáp Treo (triển khai truyền dẫn trạm BTS) + CTCT: 210609 - BQLDA/VTNet - CTCT/XL 2018​	HCQT​	15/04/2020​	10​		0%​		-10​
3	05/04/2020​	4	Quyết toán hợp đồng Công ty Tân Thanh + 120701-KTHT/VTU-TÂNTHANH/XL2018​	HCQT​	11/04/2020​	11​	9​	82%​		-14​
4	25/03/2020​	4	HCQT Hợp đồng thay thế cáp dập nát + 250401-KTHT/VTU-XÂY DỰNG VŨNG TÀU/XL 2018​	HCQT​	15/04/2020​	1​	1​	100%​		-10​
B	CÔNG VIỆC SẮP HẾT HẠN​
1	01/04/2020​	4	Điều hành triển khai thi công ngầm hóa 08 tuyến ngầm​	Truyền dẫn​	25/04/2020​	6​	6​	100%​		0​
2	10/04/2020​	4	Hoàn thành Đưa vào sử dụng các tuyến cáp ngầm kiên cố​	Truyền dẫn​	25/04/2020​	3​	3​	100%​		0​
3	08/04/2020​	4	Triển khai thi công kéo cáp quang treo cho trạm BTS: 07 tuyến​	Truyền dẫn​	25/04/2020​	6,3​		0%​		0​
4	08/04/2020​	4	Hoàn thành Đưa vào sử dụng các tuyến cáp quang treo phát sóng trạm BTS​	Truyền dẫn​	25/04/2020​	4​	4​	100%​		0​
5	01/04/2020​	4	Giảm tồn Xuất hàng đầu tư mới cho công trình truyền dẫn (treo + ngầm)​	QLTS​	25/04/2020​	2,017619​	0,4​	20%​		0​

 

[infogated]

mọi người ơi cho em hỏi với ạ, tại sao khi em copy Code của a HLMT sang file của mình thì bị báo lỗi như thế này ạ? mong được mọi người giải đáp.

 

[batman1]

mọi người ơi cho em hỏi với ạ, tại sao khi em copy Code của a HLMT sang file của mình thì bị báo lỗi như thế này ạ? mong được mọi người giải đáp.

Nếu khai báo

Dim Addresslist As Scripting.Dictionary

thì phải thêm thư viện Microsoft Scripting Runtime: Tools -> references -> Microsoft Scripting Runtime


Nếu muốn kết nối chậm thì không phải thêm thư viện như trên nhưng phải có:

Dim Addresslist As Object
...
Set Addresslist = CreateObject("Scripting.Dictionary")

 

[infogated]

Nếu khai báo

Dim Addresslist As Scripting.Dictionary

thì phải thêm thư viện Microsoft Scripting Runtime: Tools -> references -> Microsoft Scripting Runtime


Nếu muốn kết nối chậm thì không phải thêm thư viện như trên nhưng phải có:

Dim Addresslist As Object
...
Set Addresslist = CreateObject("Scripting.Dictionary")

Cám Ơn Bạn Rất Rất Nhiều, Mình Đã Làm Theo Và Hết Lỗi Rồi. ^^

 

[infogated]

Xin Lỗi Lại Làm Phiền Bạn @batman1 một lần nữa được không ạ? sau khi được bạn sửa code mình chạy đã rất ổn rồi, nhưng có một vấn đề mình không biết phải sửa làm sao, đó là mình tham chiếu mail trong code là ô B84, nếu mình tự gõ mail trong ô B84 thì sẽ gửi được, nhưng nếu mình lấy mail từ sheet khác đưa vào ô B84 thì lại không gửi được mail, mong bạn giúp đỡ ^^, cám ơn bạn nhiều.
Gõ mail trực tiếp vào ô tham chiếu thì gửi được

Bài đã được tự động gộp: 26/4/20

gõ hàm để lấy mail từ 1 sheet khác vào ô tham chiếu ví dụ như thế này thì lại không được.

 

[batman1]

Xin Lỗi Lại Làm Phiền Bạn @batman1 một lần nữa được không ạ? sau khi được bạn sửa code mình chạy đã rất ổn rồi, nhưng có một vấn đề mình không biết phải sửa làm sao, đó là mình tham chiếu mail trong code là ô B84, nếu mình tự gõ mail trong ô B84 thì sẽ gửi được, nhưng nếu mình lấy mail từ sheet khác đưa vào ô B84 thì lại không gửi được mail, mong bạn giúp đỡ ^^, cám ơn bạn nhiều.
Gõ mail trực tiếp vào ô tham chiếu thì gửi được

Bài đã được tự động gộp: 26/4/20

gõ hàm để lấy mail từ 1 sheet khác vào ô tham chiếu ví dụ như thế này thì lại không được.

Tôi không trả lời những người chỉ chơi ảnh.

Không phải lúc nào cũng nhìn thấy code trên ảnh.

 

[infogated]

Tôi không trả lời những người chỉ chơi ảnh.

Không phải lúc nào cũng nhìn thấy code trên ảnh.

xin lỗi bạn, mình vô ý quá, mình gửi file lên mong bạn hỗ trợ ^^

 

[batman1]

xin lỗi bạn, mình vô ý quá, mình gửi file lên mong bạn hỗ trợ ^^

Tại dòng này (nếu chỉ có ảnh thì không ai nhìn thấy)

cell In Columns("B").Cells.SpecialCells(xlCellTypeConstants)

Nên những ô có công thức không được xét. Chỉ các ô có hằng số (xlCellTypeConstants) mới được xét.

Nếu bạn vẫn xét từng ô trên sheet thì tôi đề nghị:
1. Thêm khai báo

Dim rng As Range

2. Thay

For Each cell In Columns("B").Cells.SpecialCells(xlCellTypeConstants)

bằng

With ThisWorkbook.Worksheets("Sheet2")
    Set rng = .Range("B1:B" & .Cells(Rows.Count, "B").End(xlUp).Row)
End With
For Each cell In rng

 

[infogated]

Tại dòng này (nếu chỉ có ảnh thì không ai nhìn thấy)

cell In Columns("B").Cells.SpecialCells(xlCellTypeConstants)

Nên những ô có công thức không được xét. Chỉ các ô có hằng số (xlCellTypeConstants) mới được xét.

Nếu bạn vẫn xét từng ô trên sheet thì tôi đề nghị:
1. Thêm khai báo

Dim rng As Range

2. Thay

For Each cell In Columns("B").Cells.SpecialCells(xlCellTypeConstants)

bằng

With ThisWorkbook.Worksheets("Sheet2")
    Set rng = .Range("B1:B" & .Cells(Rows.Count, "B").End(xlUp).Row)
End With
For Each cell In rng

Cám ơn bạn rất nhiệt tình hướng dẫn, rất hữu ích với những người mới như mình ^^

Bài đã được tự động gộp: 27/4/20

Tại dòng này (nếu chỉ có ảnh thì không ai nhìn thấy)

cell In Columns("B").Cells.SpecialCells(xlCellTypeConstants)

Nên những ô có công thức không được xét. Chỉ các ô có hằng số (xlCellTypeConstants) mới được xét.

Nếu bạn vẫn xét từng ô trên sheet thì tôi đề nghị:
1. Thêm khai báo

Dim rng As Range

2. Thay

For Each cell In Columns("B").Cells.SpecialCells(xlCellTypeConstants)

bằng

With ThisWorkbook.Worksheets("Sheet2")
    Set rng = .Range("B1:B" & .Cells(Rows.Count, "B").End(xlUp).Row)
End With
For Each cell In rng

Cám ơn bạn thêm một lần nữa, Code đã chạy theo đúng như mình mong đợi ^^

 

[hunter_312]

Bác HLMT ơi,
Em thấy các code bác viết đều để là .copypicture, như vậy dán vào email sẽ là dạng ảnh
Em để .copy mà không copy được vào outlook
Ý em là muốn có table trong oullook mà không phải dạng ảnh. Bác giúp em với

 

[tueyennhi]

Em sưu tầm được đoạn code sau dùng để tạo ảnh vùng bất kỳ. Có cách nào nâng cấp lên thêm sau khi tạo được ảnh đó thì sẽ gửi email ảnh đó theo list được không? (Mỗi ảnh gửi cho một email). Trường hợp không gửi trực tiếp trên VBA được thì có thể chỉ em làm cách nào export được ảnh đó thành file được không?

Sub DoCamera()
    Dim MyPrompt As String
    Dim MyTitle As String
    Dim UserRange As Range
    Dim OutputRange As Range

    Application.ScreenUpdating = True

    'Prompt user for range to capture
    MyPrompt = "Select the range you would like to capture."
    MyTitle = "User Input Required"
    On Error Resume Next
    Set UserRange = Application.InputBox(Prompt:=MyPrompt, _
        Title:=MyTitle, Default:=ActiveCell.Address, Type:=8)
    If UserRange Is Nothing Then End
    On Error GoTo 0

    'Copy range to Clipboard as picture
    UserRange.CopyPicture

    'Prompt user for range to paste to
    MyPrompt = "Select the range on which you would like to paste."
    MyTitle = "User Input Required"
    On Error Resume Next
    Set OutputRange = Application.InputBox(Prompt:=MyPrompt, _
        Title:=MyTitle, Default:=ActiveCell.Address, Type:=8)
    If OutputRange Is Nothing Then End
    On Error GoTo 0

    'Paste picture to output range
    OutputRange.PasteSpecial
    'Selection.Formula = UserRange.Address
    Selection.Name = "007"
End Sub

 

[tueyennhi]

Bác HLMT ơi,
Em thấy các code bác viết đều để là .copypicture, như vậy dán vào email sẽ là dạng ảnh
Em để .copy mà không copy được vào outlook
Ý em là muốn có table trong oullook mà không phải dạng ảnh. Bác giúp em với

Bạn ơi đoạn code ấy ở đâu nhỉ mình đang không thấy. Í bạn là email dạng ảnh là file ảnh chứ không phải là ảnh trong file excel?

 

[tueyennhi]

BẠn thử code sau thử:

Sub SendMail2()

    Dim OutApp As Object
    Dim OutMail As Object
    Dim cell As Range
    Dim i As Integer
    Application.ScreenUpdating = False
    Set OutApp = CreateObject("Outlook.Application")
    OutApp.Session.Logon
    With Sheet2
        For Each cell In Sheet3.[C1:C1000]
            i = i + 1
            If Len(cell) > 0 Then
                .[A1:K1000].AutoFilter Field:=11, Criteria1:=cell
                .[A1:K1000].AutoFilter Field:=7, Criteria1:="Incomplete"
                 If .Cells(Rows.Count, 7).End(xlUp).Row > 1 Then
                    .[A1].CurrentRegion.CopyPicture
                    Set OutMail = OutApp.CreateItem(0)
                    With OutMail
                       .To = cell.Value
                       .Subject = "PRODUCTS: " & Cells(cell.Row, "C").Value
                       .HTMLBody = " <B>Xin chao " & cell.Offset(, -1) & "</B>" & _
                                        "<BR><BR><BR><BR>Neu co thac mac gi xin phan hoi som" & _
                                        "<BR><B>Xin cam on,</B><BR>" & _
                                        "<BR><B>HLMT</B>"
                       .Display
                    End With
                    SendKeys "({DOWN})", True
                    SendKeys "({DOWN})", True
                    SendKeys "^({v})", True
                End If
            End If
        Next
        .ShowAllData
    End With
    Application.ScreenUpdating = True
  
End Sub

Lưu ý chuyển Table về range nhé.

Đúng cái em cần. Nhưng nếu thay Display bằng Send thì khi gửi không có ảnh anh ạ.

 

[tueyennhi]

Sub SendMail2()
    Dim OutApp As Object
    Dim OutMail As Object
    Dim Tu As Long, Den As Long, i As Long
    Set OutApp = CreateObject("Outlook.Application")
    OutApp.Session.Logon
    With Sheets("Print")
        Tu = .Range("AG2")
        Den = .Range("AH2")
        For i = Tu To Den Step 2
            .Range("AH5") = i
            .Range("A1:AB68").CopyPicture
            Set OutMail = OutApp.CreateItem(0)
            With OutMail
                .To = Sheets("Print").Range("X10").Value
                .Subject = "Phi" & ChrW(7871) & "u l" & ChrW(432) & ChrW(417) & "ng: " & Sheets("Print").Range("H2").Value
                .HTMLBody = "Xin chào " & "<B>" & Sheets("Print").Range("K4") & "</B>" & _
                "<BR><BR>Phòng Nhân s" & ChrW(7921) & " xin g" & ChrW(7917) & "i l" & ChrW(7841) & "i b" & ChrW(7843) & "ng chi ti" & ChrW(7871) & "t l" & ChrW(432) & ChrW(417) & "ng " & ChrW(273) & "ã tr" & ChrW(7843) & " (tính sai) và b" & ChrW(7843) & "ng chi ti" & ChrW(7871) & "t l" & ChrW(432) & ChrW(417) & "ng tính l" & ChrW(7841) & "i (tính " & ChrW(273) & "úng)." & _
                                "<BR><BR><B>Xin c" & ChrW(7843) & "m " & ChrW(417) & "n,</B><BR>" & _
                                "<BR><B>Phòng Nhân s" & ChrW(7921) & "!</B>"
                .display
            End With
            SendKeys "({DOWN})", True
            SendKeys "({DOWN})", True
            SendKeys "({DOWN})", True
            SendKeys "^({v})", True
        Next i
    End With
    Set OutMail = Nothing
End Sub

Cho em hỏi em thay display bằng send thì không có picture add vào mail. Em thử cho đoạn code

SendKeys "({DOWN})", True
            SendKeys "({DOWN})", True
            SendKeys "({DOWN})", True
            SendKeys "^({v})", True

lên trên phần .Send cũng không được.

 

[tueyennhi]

Có ai giúp được vấn đề của em không? Send luôn thì không có ảnh đính kèm mà để chế độ display thì phải bấm thủ công nút send nhiều lần. Em cũng đã thử cho cả lệnh display và send thì vẫn mất hình.

 

[Hai Lúa Miền Tây]

Có ai giúp được vấn đề của em không? Send luôn thì không có ảnh đính kèm mà để chế độ display thì phải bấm thủ công nút send nhiều lần. Em cũng đã thử cho cả lệnh display và send thì vẫn mất hình.

Bạn gửi file mẫu tôi xem thử nhé. Bởi vì bạn đã gửi trước khi dán thì làm sao có hình được.

 

[tueyennhi]

Bạn gửi file mẫu tôi xem thử nhé. Bởi vì bạn đã gửi trước khi dán thì làm sao có hình được.

Đây anh nhé.