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

Liên hệ QC
Z

zine

Thành viên mới
Tham gia
21/8/07
Bài viết
27
Được thích
13
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ạ.
 

File đính kèm

  • Gui email tu dong theo danh sach.xlsx
    13.2 KB · Đọc: 2,821
Sắp xếp theo thời gian sắp xếp theo bầu chọn
tueyennhi đã viết:
Thực ra không phải copy tay mà mình dùng đoạn code để lấy ID theo phòng ban, theo nhóm.
Code này chạy trên máy khác cũng office như mình thì bình thường, đính kèm ảnh ngon lành. Sang máy mình thì lại không có, cài lại office cũng vẫn vậy. Bạn chỉ mình cách nào khác mà đính kèm được ảnh là mình có thể giải quyết bài toán của mình. Hiện tại mình cũng cần gấp không có thời gian giải thích chi tiết thêm chỉ cần file thực thi chèn ảnh và gửi tự động là tốt rồi. Mong bạn có thể giúp mình tháo gỡ vấn đề chính này.
Nhấp chuột vào đây để mở rộng...
Mã: 
Option Explicit

' Chèn anh truc tiep vao mail
Sub SendMail2()
Dim OutApp As Object, OutMail As Object, objFSO As Object, oChart As Object
Dim Tu As Long, Den As Long, i As Long
Dim strPath As String, strFilePic As String
    Set OutApp = CreateObject("Outlook.Application")
    OutApp.Session.Logon
    
    Set objFSO = CreateObject("Scripting.FileSystemObject")
    strPath = ThisWorkbook.Path
    If Right(strPath, 1) <> "\" Then strPath = strPath & "\"
    strFilePic = strPath & "PicPayment.jpg"
    
    With Sheets("Print")
        Tu = .Range("AG2")
        Den = .Range("AH2")
        For i = Tu To Den Step 2
            .Range("AH5") = i
        'Xoa Attached file hien huu neu có
            If objFSO.FileExists(strFilePic) Then objFSO.DeleteFile strFilePic
        'Tao file (Pic) chi tiet luong voi tên file kem duong dan: strFilePic
            Set oChart = .Shapes.AddChart(xlColumnClustered, .Range("A1:AB68").Width, Height:=.Range("A1:AB68").Height).Chart
            .Range("A1:AB68").CopyPicture xlScreen, xlPicture
            oChart.Parent.Activate
            oChart.Paste
            oChart.Export Filename:=strFilePic, FilterName:="jpg"
            oChart.Parent.Delete
            
            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
                .Attachments.Add strFilePic, 1, 0
                .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>" & _
                                "<img src=""cid:PicPayment.jpg"" height=520 width=750>" & _
                                "<BR><BR><B>Phòng Nhân s" & ChrW(7921) & "!</B>"
                .Display
                SendKeys "({DOWN})", True
                SendKeys "({DOWN})", True
                SendKeys "({DOWN})", True
                SendKeys "^({v})", True
                .Send
            End With
            Set OutMail = Nothing
            Set oChart = Nothing
        Next i
    End With
    Set OutApp = Nothing
    Set objFSO = Nothing
    Set oChart = Nothing
End Sub
thay code gởi mail của bạn bằng code trên
 
Upvote 0
thnghiachau đã viết:
Mã: 
Option Explicit

' Chèn anh truc tiep vao mail
Sub SendMail2()
Dim OutApp As Object, OutMail As Object, objFSO As Object, oChart As Object
Dim Tu As Long, Den As Long, i As Long
Dim strPath As String, strFilePic As String
    Set OutApp = CreateObject("Outlook.Application")
    OutApp.Session.Logon
   
    Set objFSO = CreateObject("Scripting.FileSystemObject")
    strPath = ThisWorkbook.Path
    If Right(strPath, 1) <> "\" Then strPath = strPath & "\"
    strFilePic = strPath & "PicPayment.jpg"
   
    With Sheets("Print")
        Tu = .Range("AG2")
        Den = .Range("AH2")
        For i = Tu To Den Step 2
            .Range("AH5") = i
        'Xoa Attached file hien huu neu có
            If objFSO.FileExists(strFilePic) Then objFSO.DeleteFile strFilePic
        'Tao file (Pic) chi tiet luong voi tên file kem duong dan: strFilePic
            Set oChart = .Shapes.AddChart(xlColumnClustered, .Range("A1:AB68").Width, Height:=.Range("A1:AB68").Height).Chart
            .Range("A1:AB68").CopyPicture xlScreen, xlPicture
            oChart.Parent.Activate
            oChart.Paste
            oChart.Export Filename:=strFilePic, FilterName:="jpg"
            oChart.Parent.Delete
           
            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
                .Attachments.Add strFilePic, 1, 0
                .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>" & _
                                "<img src=""cid:PicPayment.jpg"" height=520 width=750>" & _
                                "<BR><BR><B>Phòng Nhân s" & ChrW(7921) & "!</B>"
                .Display
                SendKeys "({DOWN})", True
                SendKeys "({DOWN})", True
                SendKeys "({DOWN})", True
                SendKeys "^({v})", True
                .Send
            End With
            Set OutMail = Nothing
            Set oChart = Nothing
        Next i
    End With
    Set OutApp = Nothing
    Set objFSO = Nothing
    Set oChart = Nothing
End Sub
thay code gởi mail của bạn bằng code trên
Nhấp chuột vào đây để mở rộng...
Cảm ơn bạn, để mình thử nhé.
Bài đã được tự động gộp:

thnghiachau đã viết:
Mã: 
Option Explicit

' Chèn anh truc tiep vao mail
Sub SendMail2()
Dim OutApp As Object, OutMail As Object, objFSO As Object, oChart As Object
Dim Tu As Long, Den As Long, i As Long
Dim strPath As String, strFilePic As String
    Set OutApp = CreateObject("Outlook.Application")
    OutApp.Session.Logon
   
    Set objFSO = CreateObject("Scripting.FileSystemObject")
    strPath = ThisWorkbook.Path
    If Right(strPath, 1) <> "\" Then strPath = strPath & "\"
    strFilePic = strPath & "PicPayment.jpg"
   
    With Sheets("Print")
        Tu = .Range("AG2")
        Den = .Range("AH2")
        For i = Tu To Den Step 2
            .Range("AH5") = i
        'Xoa Attached file hien huu neu có
            If objFSO.FileExists(strFilePic) Then objFSO.DeleteFile strFilePic
        'Tao file (Pic) chi tiet luong voi tên file kem duong dan: strFilePic
            Set oChart = .Shapes.AddChart(xlColumnClustered, .Range("A1:AB68").Width, Height:=.Range("A1:AB68").Height).Chart
            .Range("A1:AB68").CopyPicture xlScreen, xlPicture
            oChart.Parent.Activate
            oChart.Paste
            oChart.Export Filename:=strFilePic, FilterName:="jpg"
            oChart.Parent.Delete
           
            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
                .Attachments.Add strFilePic, 1, 0
                .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>" & _
                                "<img src=""cid:PicPayment.jpg"" height=520 width=750>" & _
                                "<BR><BR><B>Phòng Nhân s" & ChrW(7921) & "!</B>"
                .Display
                SendKeys "({DOWN})", True
                SendKeys "({DOWN})", True
                SendKeys "({DOWN})", True
                SendKeys "^({v})", True
                .Send
            End With
            Set OutMail = Nothing
            Set oChart = Nothing
        Next i
    End With
    Set OutApp = Nothing
    Set objFSO = Nothing
    Set oChart = Nothing
End Sub
thay code gởi mail của bạn bằng code trên
Nhấp chuột vào đây để mở rộng...
Bạn ơi ảnh thì chèn vào được rồi nhưng mà không nhìn thấy nội dung
1597301515037.png
 
Upvote 0
tueyennhi đã viết:
Cảm ơn anh, vậy không được rồi. Vì vấn đề nhạy cảm nên em vẫn cần sử dụng form như trước kia dùng.
Nhấp chuột vào đây để mở rộng...
Vậy bạn có thể thử code sau nhé:

Mã: 
Sub SendMail2()
    Dim OutApp As Object
    Dim outMail As Object
    Dim objMailDocument 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("M1")
        Den = .Range("O1")
        For i = Tu To Den Step 1
            .Range("M2") = i
            .Range("A1:G4").CopyPicture
            Set outMail = OutApp.CreateItem(0)
            With outMail
                .To = Sheets("Print").Range("G2").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) & " và b" & ChrW(7843) & "ng chi ti" & ChrW(7871) & "t l" & ChrW(432) & ChrW(417) & "ng tính l" & ChrW(7841) & "i )." & _
                                "<BR><BR><BR><B>Xin c" & ChrW(7843) & "m " & ChrW(417) & "n,</B><BR>" & _
                               "<BR><B>Phòng Nhân s" & ChrW(7921) & "!</B><br><a href=https://www.giaiphapexcel.com/diendan/threads/g%E1%BB%ADi-email-t%C3%ADnh-l%C6%B0%C6%A1ng-cho-t%E1%BB%ABng-ng%C6%B0%E1%BB%9Di.48211/page-17>Xem thêm tai dây</a><br><strong>Hai Lúa Miên Tây</strong>"
                .Display
                Set objMailDocument = outMail.GetInspector.WordEditor
                objMailDocument.Range(100, 100).Paste
                .send
            End With
            Set outMail = Nothing
        Next i
    End With
    Set OutApp = Nothing
End Sub
 
Upvote 0
tueyennhi đã viết:
Cảm ơn bạn, để mình thử nhé.
Bài đã được tự động gộp:


Bạn ơi ảnh thì chèn vào được rồi nhưng mà không nhìn thấy nội dung
View attachment 243038
Nhấp chuột vào đây để mở rộng...
đó bạn thấy chưa? xử lý hình ảnh không phải là đơn giản, thế tại sao bạn không gởi file Pdf cho dễ dàng hơn??? pdf thì cũng như hình ảnh thôi, chỉ tạo đúng vùng A1:AB68 đó!!!!!!!!!!!!!!!!

Mã: 
Option Explicit

Sub SendMail2()
Dim OutApp As Object, OutMail As Object, objFSO As Object, oChart As Object
Dim Tu As Long, Den As Long, i As Long
Dim strPath As String, strFileAtt As String
    Set OutApp = CreateObject("Outlook.Application")
    OutApp.Session.Logon
    
    Set objFSO = CreateObject("Scripting.FileSystemObject")
    strPath = ThisWorkbook.Path
    If Right(strPath, 1) <> "\" Then strPath = strPath & "\"
    strFileAtt = strPath & "Payment.Pdf"
    
    With Sheets("Print")
        Tu = .Range("AG2")
        Den = .Range("AH2")
        For i = Tu To Den Step 2
            .Range("AH5") = i
        'Xoa Attached file hien huu neu có
            If objFSO.FileExists(strFileAtt) Then objFSO.DeleteFile strFileAtt
        'Tao file attached (.Pdf) chi tiet luong
            .Range("A1:AB68").ExportAsFixedFormat Type:=xlTypePDF, _
                                                  Filename:=strFileAtt, _
                                                  Quality:=xlQualityStandard, _
                                                  IncludeDocProperties:=True, _
                                                  IgnorePrintAreas:=False, _
                                                  OpenAfterPublish:=False
            
            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
                .Attachments.Add strFileAtt, 1, 0
                .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>" & _
                                "<BR><BR><B>Phòng Nhân s" & ChrW(7921) & "!</B>"
                .Display
                SendKeys "({DOWN})", True
                SendKeys "({DOWN})", True
                SendKeys "({DOWN})", True
                SendKeys "^({v})", True
                .Send
            End With
            If objFSO.FileExists(strFileAtt) Then objFSO.DeleteFile strFileAtt
            Set OutMail = Nothing
            Set oChart = Nothing
        Next i
    End With
    Set OutApp = Nothing
    Set objFSO = Nothing
    Set oChart = Nothing
End Sub
 
Lần chỉnh sửa cuối:
Upvote 0
Hai Lúa Miền Tây đã viết:
Vậy bạn có thể thử code sau nhé:

Mã: 
Sub SendMail2()
    Dim OutApp As Object
    Dim outMail As Object
    Dim objMailDocument 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("M1")
        Den = .Range("O1")
        For i = Tu To Den Step 1
            .Range("M2") = i
            .Range("A1:G4").CopyPicture
            Set outMail = OutApp.CreateItem(0)
            With outMail
                .To = Sheets("Print").Range("G2").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) & " và b" & ChrW(7843) & "ng chi ti" & ChrW(7871) & "t l" & ChrW(432) & ChrW(417) & "ng tính l" & ChrW(7841) & "i )." & _
                                "<BR><BR><BR><B>Xin c" & ChrW(7843) & "m " & ChrW(417) & "n,</B><BR>" & _
                               "<BR><B>Phòng Nhân s" & ChrW(7921) & "!</B><br><a href=https://www.giaiphapexcel.com/diendan/threads/g%E1%BB%ADi-email-t%C3%ADnh-l%C6%B0%C6%A1ng-cho-t%E1%BB%ABng-ng%C6%B0%E1%BB%9Di.48211/page-17>Xem thêm tai dây</a><br><strong>Hai Lúa Miên Tây</strong>"
                .Display
                Set objMailDocument = outMail.GetInspector.WordEditor
                objMailDocument.Range(100, 100).Paste
                .send
            End With
            Set outMail = Nothing
        Next i
    End With
    Set OutApp = Nothing
End Sub
Nhấp chuột vào đây để mở rộng...
Ảnh chèn vào rồi mà phân giải thấp không nhìn được rõ nội dung anh ạ. Chắc cũng chỉ đến được như vậy :(. Vì nội dung của em thể hiện trong bài 305 nó là một vùng từ A1 đến AB68
Bài đã được tự động gộp:

thnghiachau đã viết:
đó bạn thấy chưa? xử lý hình ảnh không phải là đơn giản, thế tại sao bạn không gởi file Pdf cho dễ dàng hơn??? pdf thì cũng như hình ảnh thôi, chỉ tạo đúng vùng A1:AB68 đó!!!!!!!!!!!!!!!!

Mã: 
Option Explicit

Sub SendMail2()
Dim OutApp As Object, OutMail As Object, objFSO As Object, oChart As Object
Dim Tu As Long, Den As Long, i As Long
Dim strPath As String, strFileAtt As String
    Set OutApp = CreateObject("Outlook.Application")
    OutApp.Session.Logon
  
    Set objFSO = CreateObject("Scripting.FileSystemObject")
    strPath = ThisWorkbook.Path
    If Right(strPath, 1) <> "\" Then strPath = strPath & "\"
    strFileAtt = strPath & "Payment.Pdf"
  
    With Sheets("Print")
        Tu = .Range("AG2")
        Den = .Range("AH2")
        For i = Tu To Den Step 2
            .Range("AH5") = i
        'Xoa Attached file hien huu neu có
            If objFSO.FileExists(strFileAtt) Then objFSO.DeleteFile strFileAtt
        'Tao file attached (.Pdf) chi tiet luong
            .Range("A1:AB68").ExportAsFixedFormat Type:=xlTypePDF, _
                                                  Filename:=strFileAtt, _
                                                  Quality:=xlQualityStandard, _
                                                  IncludeDocProperties:=True, _
                                                  IgnorePrintAreas:=False, _
                                                  OpenAfterPublish:=False
          
            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
                .Attachments.Add strFileAtt, 1, 0
                .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>" & _
                                "<BR><BR><B>Phòng Nhân s" & ChrW(7921) & "!</B>"
                .Display
                SendKeys "({DOWN})", True
                SendKeys "({DOWN})", True
                SendKeys "({DOWN})", True
                SendKeys "^({v})", True
                .Send
            End With
            If objFSO.FileExists(strFileAtt) Then objFSO.DeleteFile strFileAtt
            Set OutMail = Nothing
            Set oChart = Nothing
        Next i
    End With
    Set OutApp = Nothing
    Set objFSO = Nothing
    Set oChart = Nothing
End Sub
Nhấp chuột vào đây để mở rộng...
Nếu chuyển pdf thì mình phải sửa như nào? Căn bản sợ máy CNV không đọc được hoặc có người không biết. Vì vậy mình mới chọn phương án hiện ảnh trực tiếp.
 
Upvote 0
tueyennhi đã viết:
Nếu chuyển pdf thì mình phải sửa như nào? Căn bản sợ máy CNV không đọc được hoặc có người không biết. Vì vậy mình mới chọn phương án hiện ảnh trực tiếp.
Nhấp chuột vào đây để mở rộng...
Nay mà còn sợ có người không đọc được pdf? Các "ông trình duyệt" đã đọc giúp từ lâu rồi.
 
Upvote 0
tueyennhi đã viết:
Ảnh chèn vào rồi mà phân giải thấp không nhìn được rõ nội dung anh ạ. Chắc cũng chỉ đến được như vậy :(. Vì nội dung của em thể hiện trong bài 305 nó là một vùng từ A1 đến AB68
Nhấp chuột vào đây để mở rộng...
Vậy bạn có đồng ý copy nguyên bảng dữ liệu và dán vào Outlook giữ nguyên định dạng gốc bên excel? Chỉ khác chỗ thay ảnh thành bảng dữ liệu.
 
Upvote 0
tueyennhi đã viết:
Đồng ý anh ơi, miễn sao thể hiện hết nội dung và form giữ nguyên anh ạ.
Nhấp chuột vào đây để mở rộng...
Vậy bạn thử code sau nhé:

Mã: 
Option Explicit
Sub SendMail2()
    Dim OutApp As Object
    Dim outMail As Object
    Dim objMailDocument 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("M1")
        Den = .Range("O1")
        For i = Tu To Den Step 1
            .Range("M2") = i
            .Range("A1:G4").Copy 'Picture
            Set outMail = OutApp.CreateItem(0)
            With outMail
                .To = Sheets("Print").Range("G2").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) & " và b" & ChrW(7843) & "ng chi ti" & ChrW(7871) & "t l" & ChrW(432) & ChrW(417) & "ng tính l" & ChrW(7841) & "i )." & _
                                "<BR><BR><BR><B>Xin c" & ChrW(7843) & "m " & ChrW(417) & "n,</B><BR>" & _
                               "<BR><B>Phòng Nhân s" & ChrW(7921) & "!</B><br><a href=https://www.giaiphapexcel.com/diendan/threads/g%E1%BB%ADi-email-t%C3%ADnh-l%C6%B0%C6%A1ng-cho-t%E1%BB%ABng-ng%C6%B0%E1%BB%9Di.48211/page-17>Xem thêm tai dây</a><br><strong>Hai Lúa Miên Tây</strong>"
                .Display
                Set objMailDocument = outMail.GetInspector.WordEditor
                objMailDocument.Range(100, 100).PasteAndFormat 1
                .send
            End With
            Set outMail = Nothing
        Next i
    End With
    Set OutApp = Nothing
End Sub
 
Upvote 0
tueyennhi đã viết:
Cảm ơn bạn, để mình thử nhé.
Bài đã được tự động gộp:


Bạn ơi ảnh thì chèn vào được rồi nhưng mà không nhìn thấy nội dung
View attachment 243038
Nhấp chuột vào đây để mở rộng...
Tôi đã xử lý cái hình không nhhi2n thấy cho bạn được rồi nè...
Bạn chép code này vào code gởi mail của bạn nha
Mã: 
Option Explicit

' Chèn anh truc tiep vao mail
Sub SendMail2()
Dim OutApp As Object, OutMail As Object, objFSO As Object, oChart As Object
Dim Tu As Long, Den As Long, i As Long
Dim strPath As String, strFilePic As String
Dim dbWidth As Double, dbHeight As Double
    Set OutApp = CreateObject("Outlook.Application")
    OutApp.Session.Logon
    
    Set objFSO = CreateObject("Scripting.FileSystemObject")
    strPath = ThisWorkbook.Path
    If Right(strPath, 1) <> "\" Then strPath = strPath & "\"
    strFilePic = strPath & "PicPayment.jpg"
    
    With Sheets("Print")
        
        Tu = .Range("AG2")
        Den = .Range("AH2")
        For i = Tu To Den Step 2
            .Range("AH5") = i
            If objFSO.FileExists(strFilePic) Then objFSO.DeleteFile strFilePic
            .Range("A1:AB68").CopyPicture xlScreen, xlPicture
            dbWidth = Round(.Range("A1:AB68").Width, 0)
            dbHeight = Round(.Range("A1:AB68").Height, 0)
            .Range("A1").Select
            Set oChart = .Shapes.AddChart(Width:=dbWidth, Height:=dbHeight).Chart
            oChart.Parent.Activate
            oChart.Paste
            oChart.Export Filename:=strFilePic, FilterName:="jpg"
            oChart.Parent.Delete
            
            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
                .Attachments.Add strFilePic, 1, 0
                .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>" & _
                                "<BR><BR><B>Phòng Nhân s" & ChrW(7921) & "!</B>" & _
                                "<img src=""cid:PicPayment.jpg"">"
                .Display
                SendKeys "({DOWN})", True
                SendKeys "({DOWN})", True
                SendKeys "({DOWN})", True
                SendKeys "^({v})", True
                .Send
            End With
            If objFSO.FileExists(strFilePic) Then objFSO.DeleteFile strFilePic
            Set OutMail = Nothing
            Set oChart = Nothing
        Next i
    End With
    Set OutApp = Nothing
    Set objFSO = Nothing
    Set oChart = Nothing
End Sub
 
Upvote 0
Hai Lúa Miền Tây đã viết:
Vậy bạn thử code sau nhé:

Mã: 
Option Explicit
Sub SendMail2()
    Dim OutApp As Object
    Dim outMail As Object
    Dim objMailDocument 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("M1")
        Den = .Range("O1")
        For i = Tu To Den Step 1
            .Range("M2") = i
            .Range("A1:G4").Copy 'Picture
            Set outMail = OutApp.CreateItem(0)
            With outMail
                .To = Sheets("Print").Range("G2").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) & " và b" & ChrW(7843) & "ng chi ti" & ChrW(7871) & "t l" & ChrW(432) & ChrW(417) & "ng tính l" & ChrW(7841) & "i )." & _
                                "<BR><BR><BR><B>Xin c" & ChrW(7843) & "m " & ChrW(417) & "n,</B><BR>" & _
                               "<BR><B>Phòng Nhân s" & ChrW(7921) & "!</B><br><a href=https://www.giaiphapexcel.com/diendan/threads/g%E1%BB%ADi-email-t%C3%ADnh-l%C6%B0%C6%A1ng-cho-t%E1%BB%ABng-ng%C6%B0%E1%BB%9Di.48211/page-17>Xem thêm tai dây</a><br><strong>Hai Lúa Miên Tây</strong>"
                .Display
                Set objMailDocument = outMail.GetInspector.WordEditor
                objMailDocument.Range(100, 100).PasteAndFormat 1
                .send
            End With
            Set outMail = Nothing
        Next i
    End With
    Set OutApp = Nothing
End Sub
Nhấp chuột vào đây để mở rộng...
Vẫn vậy anh ạ, các nội dung bé không hiện rõ được.1597306973765.png
 
Upvote 0
thnghiachau đã viết:
Tôi đã xử lý cái hình không nhhi2n thấy cho bạn được rồi nè...
Bạn chép code này vào code gởi mail của bạn nha
Mã: 
Option Explicit

' Chèn anh truc tiep vao mail
Sub SendMail2()
Dim OutApp As Object, OutMail As Object, objFSO As Object, oChart As Object
Dim Tu As Long, Den As Long, i As Long
Dim strPath As String, strFilePic As String
Dim dbWidth As Double, dbHeight As Double
    Set OutApp = CreateObject("Outlook.Application")
    OutApp.Session.Logon
   
    Set objFSO = CreateObject("Scripting.FileSystemObject")
    strPath = ThisWorkbook.Path
    If Right(strPath, 1) <> "\" Then strPath = strPath & "\"
    strFilePic = strPath & "PicPayment.jpg"
   
    With Sheets("Print")
       
        Tu = .Range("AG2")
        Den = .Range("AH2")
        For i = Tu To Den Step 2
            .Range("AH5") = i
            If objFSO.FileExists(strFilePic) Then objFSO.DeleteFile strFilePic
            .Range("A1:AB68").CopyPicture xlScreen, xlPicture
            dbWidth = Round(.Range("A1:AB68").Width, 0)
            dbHeight = Round(.Range("A1:AB68").Height, 0)
            .Range("A1").Select
            Set oChart = .Shapes.AddChart(Width:=dbWidth, Height:=dbHeight).Chart
            oChart.Parent.Activate
            oChart.Paste
            oChart.Export Filename:=strFilePic, FilterName:="jpg"
            oChart.Parent.Delete
           
            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
                .Attachments.Add strFilePic, 1, 0
                .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>" & _
                                "<BR><BR><B>Phòng Nhân s" & ChrW(7921) & "!</B>" & _
                                "<img src=""cid:PicPayment.jpg"">"
                .Display
                SendKeys "({DOWN})", True
                SendKeys "({DOWN})", True
                SendKeys "({DOWN})", True
                SendKeys "^({v})", True
                .Send
            End With
            If objFSO.FileExists(strFilePic) Then objFSO.DeleteFile strFilePic
            Set OutMail = Nothing
            Set oChart = Nothing
        Next i
    End With
    Set OutApp = Nothing
    Set objFSO = Nothing
    Set oChart = Nothing
End Sub
Nhấp chuột vào đây để mở rộng...
Ôi ngon rồi bạn ơi. Cảm ơn bạn thnghiachau, cảm ơn anh Hai Lúa Miền Tây!
Bài đã được tự động gộp:

Hai Lúa Miền Tây đã viết:
Lạ nhỉ, Bạn xem lại giúp nó là dạng text hay là dạng ảnh nhé.
Nhấp chuột vào đây để mở rộng...
Dạng ảnh anh ạ.
 
Upvote 0
tueyennhi đã viết:
Nếu chuyển pdf thì mình phải sửa như nào? Căn bản sợ máy CNV không đọc được hoặc có người không biết. Vì vậy mình mới chọn phương án hiện ảnh trực tiếp.
Nhấp chuột vào đây để mở rộng...
Bạn coi lại bài #325 đi, tôi có đưa code cho bạn luôn rùi đó
Nhắc lại: bạn coi bài #331, Tôi cũng đã chỉnh lại việc không nhìn thấy luôn cho bạn rùi, tôi chay thử code và nhận hình OK lắm!!!
 
Upvote 0
Upvote 0
Hai Lúa Miền Tây đã viết:
Vậy bạn có chắc là bạn chạy đúng code trên không, đặc biệt chỗ
.Range("A1:G4").Copy 'Picture
Nhấp chuột vào đây để mở rộng...
Hai Lúa Miền Tây đã viết:
Vậy bạn có chắc là bạn chạy đúng code trên không, đặc biệt chỗ
Phải là
.Range("A1:G4").Copy 'Picture
Chứ không phải
.Range("A1:G4").CopyPicture
Nhấp chuột vào đây để mở rộng...
Em thay bằng vùng thực tế của em là A1:AB68 anh
Hai Lúa Miền Tây đã viết:
Vậy bạn có chắc là bạn chạy đúng code trên không, đặc biệt chỗ
Phải là
.Range("A1:G4").Copy 'Picture
Chứ không phải
.Range("A1:G4").CopyPicture
Nhấp chuột vào đây để mở rộng...
Em xin lỗi em bổ sung thêm mỗi dòng
Set objMailDocument = OutMail.GetInspector.WordEditor
objMailDocument.Range(100, 100).PasteAndFormat 1
Sửa lại bỏ picture thành .Range("A1:AB68").Copy thì cũng ổn rồi anh ạ. Cảm ơn anh nhé!
.
Bài đã được tự động gộp:

thnghiachau đã viết:
Phù phù... hết một buổi chiều bị bạn quay chóng mặt luôn....
Nhưng dù sao làm được thì mừng vì mình mới học được cái hay!!!
Cám ơn bạn nhá....
Nhấp chuột vào đây để mở rộng...
Hiiiiii, trình mình chưa thể hiểu được cái hay hay bạn khám phá. Mình xử lý công việc đã nhé. Cảm ơn rất nhiều!
 
Upvote 0
thnghiachau đã viết:
Tôi đã xử lý cái hình không nhhi2n thấy cho bạn được rồi nè...
Bạn chép code này vào code gởi mail của bạn nha
Mã: 
Option Explicit

' Chèn anh truc tiep vao mail
Sub SendMail2()
Dim OutApp As Object, OutMail As Object, objFSO As Object, oChart As Object
Dim Tu As Long, Den As Long, i As Long
Dim strPath As String, strFilePic As String
Dim dbWidth As Double, dbHeight As Double
    Set OutApp = CreateObject("Outlook.Application")
    OutApp.Session.Logon
   
    Set objFSO = CreateObject("Scripting.FileSystemObject")
    strPath = ThisWorkbook.Path
    If Right(strPath, 1) <> "\" Then strPath = strPath & "\"
    strFilePic = strPath & "PicPayment.jpg"
   
    With Sheets("Print")
       
        Tu = .Range("AG2")
        Den = .Range("AH2")
        For i = Tu To Den Step 2
            .Range("AH5") = i
            If objFSO.FileExists(strFilePic) Then objFSO.DeleteFile strFilePic
            .Range("A1:AB68").CopyPicture xlScreen, xlPicture
            dbWidth = Round(.Range("A1:AB68").Width, 0)
            dbHeight = Round(.Range("A1:AB68").Height, 0)
            .Range("A1").Select
            Set oChart = .Shapes.AddChart(Width:=dbWidth, Height:=dbHeight).Chart
            oChart.Parent.Activate
            oChart.Paste
            oChart.Export Filename:=strFilePic, FilterName:="jpg"
            oChart.Parent.Delete
           
            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
                .Attachments.Add strFilePic, 1, 0
                .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>" & _
                                "<BR><BR><B>Phòng Nhân s" & ChrW(7921) & "!</B>" & _
                                "<img src=""cid:PicPayment.jpg"">"
                .Display
                SendKeys "({DOWN})", True
                SendKeys "({DOWN})", True
                SendKeys "({DOWN})", True
                SendKeys "^({v})", True
                .Send
            End With
            If objFSO.FileExists(strFilePic) Then objFSO.DeleteFile strFilePic
            Set OutMail = Nothing
            Set oChart = Nothing
        Next i
    End With
    Set OutApp = Nothing
    Set objFSO = Nothing
    Set oChart = Nothing
End Sub
Nhấp chuột vào đây để mở rộng...
Ahhhh, trong code của tôi bạn xóa các dòng:
.Display
SendKeys "({DOWN})", True
SendKeys "({DOWN})", True
SendKeys "({DOWN})", True
SendKeys "^({v})", True
đi nha,
Nó sẽ không hiện ra cái outlook editor mà nó send mail cho bạn luôn, như thế bạn khỏi mắc công vừa nhấn vừa đơi nó send mail rùi đợi nhấn và send kế tiếp....
Bạn đi uống cafe rùi quay lại thì xong nha!
 
Upvote 0
Bạn phải đăng nhập hoặc đăng ký để trả lời bài viết tại đây.
Web KT

Bài viết mới nhất

PhanTuHuong
Bàn về môn thể thao bóng bàn nào!
    • Thích
    • Yêu thích
    • Cười
2
Trả lời
35
Đọc
2K
VetMini
V
S
  • Question
Xin file excel bảng giá quần áo, trang phục, phụ kiện
Trả lời
2
Đọc
27
VetMini
V
P
Tổng hợp dữ liệu từ các sheet theo chọn lọc
Trả lời
19
Đọc
339
VetMini
V
dung09031989
Xin giúp công thức tô màu các ô phía sau khi kế hoạch đặt hàng thiếu so với tồn kho.?
Trả lời
4
Đọc
128
VetMini
V
C
Chia sẻ: Kết quả xổ số Keno
    • Cười
    • Thích
Trả lời
13
Đọc
335
VetMini
V
P
Nhờ giúp đỡ hàm lọc dữ liệu theo tỉnh
Trả lời
9
Đọc
116
VetMini
V
triplet123
GIÚP EM VỚI Ạ EM CẢM ƠN MỌI NGƯỜI NHIỀU Ạ
    • Phẫn nộ
Trả lời
0
Đọc
36
triplet123
triplet123
H
Tính và sắp xếp theo thư tự tăng dần có điều kiệu (có dữ liệu trùng nhau)
Trả lời
2
Đọc
60
longtay1111
L
nobita994
Trừ số lượng dần theo dòng khi quét Sumif tổng có tên sản phẩm bị trùng.
Trả lời
0
Đọc
32
nobita994
nobita994
kimtanmap
  • Question
Nhờ viết code VBA Macro lập lại.
Trả lời
6
Đọc
206
kimtanmap
kimtanmap
20050911
File Excel lỗi ''The file could not be accessed. Try one of the following:.."
Trả lời
4
Đọc
180
VetMini
V
ongke0711
  • Question
Trộn dữ liệu từ Excel sang Word mở rộng (phiên bản ongke0711)
    • Thích
    • Yêu thích
    • Cảm ơn
11 12 13
Trả lời
257
Đọc
25K
Pham Ha 233
Pham Ha 233
C
Công thức tự nhập liệu số lượng nhập khi bị âm
Trả lời
2
Đọc
120
cherry0187
C
N
Vẽ biểu đồ kết hợp nhiều yếu tố trong excel
Trả lời
4
Đọc
125
Ny Ny 2024
N
ongke0711
  • Question
Tải hóa đơn điện tử (https://hoadondientu.gdt.gov.vn/) Excel Vba
    • Thích
    • Yêu thích
11 12 13
Trả lời
251
Đọc
13K
ongke0711
ongke0711
N
Định mức nguyên vật liệu
Trả lời
1
Đọc
174
yeudoi
yeudoi
GPE-Trợ Lý
KHÓA HỌC BỨT PHÁ KỸ NĂNG EXCEL
    • Thích
Trả lời
1
Đọc
323
PhanTuHuong
PhanTuHuong
B
Định dạng condition formatting, đếm hỗn hợp dữ liệu merge và không merge
Trả lời
17
Đọc
206
batista911
B
Tuấn Bụng Bự
  • Question
Tìm Bộ 8 số xuất hiện nhiều nhất trong random( 1 - 80)
2
Trả lời
30
Đọc
729
huuthang_bd
huuthang_bd
V
  • Question
Lấy dữ liệu lãi suất từ website Sbv.gov.vn bằng Power Query
Trả lời
1
Đọc
526
Minhhanhsgu
M
Xem thêm…

Thành viên có số lượng bài viết cao nhất tháng

Thành viên có điểm tương tác cao nhất tháng

Back
Top Bottom