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

zine · 25/4/11

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ạ.

tueyennhi · 13/8/20

thnghiachau đã viết:
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!

Hết dịch làm vại bia nhé bạn

thnghiachau · 13/8/20

tueyennhi đã viết:
Hết dịch làm vại bia nhé bạn

Bị dịch nên nghỉ từ tết tới hè... giờ sắp nghỉ từ hè tới tết....
"lèm seo mè" uống rượu được đây nhỉ???

batman1 · 13/8/20

thnghiachau đã viết:
và thêm nữa tại sao phải tạo picture để ở khu vực F6:AB9 ???

Tôi cho bạn ví dụ thực tế.

Tuy không đặt ảnh ở F6:AB9 nhưng bản chất như nhau.

A1 = "Công ty TNHH Thăng Long"
Chèn logo của công ty vào A2:A6

Gửi: vd. A1: G25

tueyennhi · 14/8/20

batman1 đã viết:
Tôi cho bạn ví dụ thực tế.
Tuy không đặt ảnh ở F6:AB9 nhưng bản chất như nhau.

A1 = "Công ty TNHH Thăng Long"
Chèn logo của công ty vào A2:A6

Gửi: vd. A1: G25

Chào anh batman1 !
Em ngưỡng mộ anh từ lâu. Anh có thể chỉ thêm một cách khác cho em học hỏi được không ạ?

quynhu200783 · 17/8/20

Mọi người coi giúp giùm em, sao code của em tạo được pdf, ra email nhưng nó lại không chèn pdf vào email. Với nếu muốn tạo password cho file pdf theo ô trong sheet thì có đc ko ạ. Cám ơn mọi người

tueyennhi · 17/8/20

quynhu200783 đã viết:
Mọi người coi giúp giùm em, sao code của em tạo được pdf, ra email nhưng nó lại không chèn pdf vào email. Với nếu muốn tạo password cho file pdf theo ô trong sheet thì có đc ko ạ. Cám ơn mọi người

Bạn thử đọc bài 325 nhé.

anhtuan2939 · 17/8/20

tueyennhi đã viết:
có thể chỉ thêm một cách khác cho em học hỏi được không ạ?

Bạn tạo 1 cái form đăng nhập và tạo tài khoản đăng nhập cho các nhân viên trong công ty. Sau đó bạn có thể gửi nguyên cả file lương lên nhóm của công ty để mọi người đăng nhập vào. Người nào đăng nhập thì chỉ xem được phần lương của người đó.

dongducnhiem · 18/8/20

quynhu200783 đã viết:
Mọi người coi giúp giùm em, sao code của em tạo được pdf, ra email nhưng nó lại không chèn pdf vào email.

Bạn đọc tất cả các bài trong chủ đề này

Gửi thư không dùng Outlook mà dùng CDO những vẫn dùng gmail bảo vệ 2 lớp

Xin chào các bạn thành viên Vừa rồi tôi được các thành viên viết VBA cho gởi thư hàng loạt dùng CDO...

www.giaiphapexcel.com

quynhu200783 đã viết:
Với nếu muốn tạo password cho file pdf theo ô trong sheet thì có đc ko ạ.

Đã gởi mail riêng thì cần pass làm chi cho phức tạp?

quynhu200783 · 18/8/20

dongducnhiem đã viết:
Bạn đọc tất cả các bài trong chủ đề này

Gửi thư không dùng Outlook mà dùng CDO những vẫn dùng gmail bảo vệ 2 lớp

Xin chào các bạn thành viên Vừa rồi tôi được các thành viên viết VBA cho gởi thư hàng loạt dùng CDO...

www.giaiphapexcel.com

Đã gởi mail riêng thì cần pass làm chi cho phức tạp?

Vấn đề là nếu bạn nào vô tình vào máy mà mở lên thì vẫn đọc được payslip á bạn.

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

tueyennhi đã viết:
Bạn thử đọc bài 325 nhé.

Mình không chuyên lắm nên nhìn code không biết được lỗi, file của mình là tạo được pdf rồi, hiện ra email rồi nhưng vấn đề là file pdf không insert vào email được.

thnghiachau · 18/8/20

quynhu200783 đã viết:
Mọi người coi giúp giùm em, sao code của em tạo được pdf, ra email nhưng nó lại không chèn pdf vào email. Với nếu muốn tạo password cho file pdf theo ô trong sheet thì có đc ko ạ. Cám ơn mọi người

code bạn:

Mã:

Option Explicit

Sub SendMail()
Dim OutApp As Object
Dim OutMail As Object
Dim printFrom As Variant, printTo As Variant
Dim sFile As String
Dim sPath As String
Dim i As Long
    printFrom = Sheets("Payslip").Range("G13")
    printTo = Sheets("Payslip").Range("G14")
    Set OutApp = CreateObject("Outlook.Application")
    For i = printFrom To printTo
        Sheets("Payslip").Range("G10") = i
        sPath = Application.ActiveWorkbook.Path
        sFile = sPath & "\" & "Payslip Dec 2019 - " & Sheets("Payslip").Range("B5") & ".pdf"
        Sheets("Payslip").Range("A1:C55").ExportAsFixedFormat Type:=xlTypePDF, _
                                                              filename:=sFile, _
                                                              Quality:=xlQualityStandard, _
                                                              IncludeDocProperties:=True, _
                                                              IgnorePrintAreas:=False, _
                                                              OpenAfterPublish:=False
        Set OutMail = OutApp.CreateItem(0)
        With OutMail
            .To = Sheets("Payslip").Range("B6")
            .CC = ""
            .BCC = ""
            .Subject = "Payslip Jan 2020"
            .HTMLBody = " Dear " & Sheets("Payslip").Range("B5") & "</B> <BR><BR> Kindly find attachment payslip of December 2019. <BR>" & _
                        "<BR>Should you have any questions, do not hestitate to contact us." & _
                        "<BR><BR>Thanks & regards</B><BR>" & _
                        "</B>"
            .Attachments.Add (sFile)
            .Send
        End With
        Set OutMail = Nothing
    Next i
    Set OutApp = Nothing
    Set OutMail = Nothing

End Sub

quynhu200783 · 18/8/20

Cám ơn bạn

An.BA · 18/8/20

thnghiachau đã viết:
code bạn:
..............

Chào bạn,
bạn có thể giúp mình xem đoạn code này không.
Có vấn đề ở đoạn code này là trong phạm vi copy thì nó không thể copy ảnh trong phạm vi đó và chữ định dạng thế nào thì nó cũng về mặc định của nó.
Cảm ơn bạn!

Mã:

'=====================COPY RANGE TO HTML===================
Function RangetoHTML(rng As Range)
' Changed by Ron de Bruin 28-Oct-2006
' Working in Office 2000-2013
    Dim fso As Object
    Dim ts As Object
    Dim TempFile As String
    Dim TempWB As Workbook


    TempFile = Environ$("temp") & "\" & Format(Now, "dd-mm-yy h-mm-ss") & ".htm"


    'Copy the range and create a new workbook to past the data in
    rng.Copy
    Set TempWB = Workbooks.Add(1)
    With TempWB.Sheets(1)
        .Cells(1).PasteSpecial Paste:=8
        .Cells(1).PasteSpecial xlPasteValues, , False, False
        .Cells(1).PasteSpecial xlPasteFormats, , False, False
        .Cells(1).Select
        Application.CutCopyMode = False
        On Error Resume Next
        .DrawingObjects.Visible = True
        .DrawingObjects.Delete
        On Error GoTo 0
    End With


    'Publish the sheet to a htm file
    With TempWB.PublishObjects.Add( _
         SourceType:=xlSourceRange, _
         Filename:=TempFile, _
         Sheet:=TempWB.Sheets(1).Name, _
         Source:=TempWB.Sheets(1).UsedRange.Address, _
         HtmlType:=xlHtmlStatic)
        .Publish (True)
    End With


    'Read all data from the htm file into RangetoHTML
    Set fso = CreateObject("Scripting.FileSystemObject")
    Set ts = fso.GetFile(TempFile).OpenAsTextStream(1, -2)
RangetoHTML = ts.readall
    ts.Close
    RangetoHTML = Replace(RangetoHTML, "align=center x:publishsource=", _
                          "align=left x:publishsource=")


    'Close TempWB
    TempWB.Close savechanges:=False


    'Delete the htm file we used in this function
    Kill TempFile


    Set ts = Nothing
    Set fso = Nothing
    Set TempWB = Nothing
End Function

thnghiachau · 18/8/20

An.BA đã viết:

Chào bạn,
bạn có thể giúp mình xem đoạn code này không.
Có vấn đề ở đoạn code này là trong phạm vi copy thì nó không thể copy ảnh trong phạm vi đó và chữ định dạng thế nào thì nó cũng về mặc định của nó.
Cảm ơn bạn!

Mã:

'=====================COPY RANGE TO HTML===================
Function RangetoHTML(rng As Range)
' Changed by Ron de Bruin 28-Oct-2006
' Working in Office 2000-2013
    Dim fso As Object
    Dim ts As Object
    Dim TempFile As String
    Dim TempWB As Workbook


    TempFile = Environ$("temp") & "\" & Format(Now, "dd-mm-yy h-mm-ss") & ".htm"


    'Copy the range and create a new workbook to past the data in
    rng.Copy
    Set TempWB = Workbooks.Add(1)
    With TempWB.Sheets(1)
        .Cells(1).PasteSpecial Paste:=8
        .Cells(1).PasteSpecial xlPasteValues, , False, False
        .Cells(1).PasteSpecial xlPasteFormats, , False, False
        .Cells(1).Select
        Application.CutCopyMode = False
        On Error Resume Next
        .DrawingObjects.Visible = True
        .DrawingObjects.Delete
        On Error GoTo 0
    End With


    'Publish the sheet to a htm file
    With TempWB.PublishObjects.Add( _
         SourceType:=xlSourceRange, _
         Filename:=TempFile, _
         Sheet:=TempWB.Sheets(1).Name, _
         Source:=TempWB.Sheets(1).UsedRange.Address, _
         HtmlType:=xlHtmlStatic)
        .Publish (True)
    End With


    'Read all data from the htm file into RangetoHTML
    Set fso = CreateObject("Scripting.FileSystemObject")
    Set ts = fso.GetFile(TempFile).OpenAsTextStream(1, -2)
RangetoHTML = ts.readall
    ts.Close
    RangetoHTML = Replace(RangetoHTML, "align=center x:publishsource=", _
                          "align=left x:publishsource=")


    'Close TempWB
    TempWB.Close savechanges:=False


    'Delete the htm file we used in this function
    Kill TempFile


    Set ts = Nothing
    Set fso = Nothing
    Set TempWB = Nothing
End Function

Cái này hình như không dính dáng gì tới chủ đề "gởi Email tính lương cho từng người" thì phải?
bạn có thể lập ra cái chủ đề mới để mọi người giúp bạn nha.
Xin lỗi, mình không rành về cái dụ này lắm.

An.BA · 18/8/20

thnghiachau đã viết:
Cái này hình như không dính dáng gì tới chủ đề "gởi Email tính lương cho từng người" thì phải?
bạn có thể lập ra cái chủ đề mới để mọi người giúp bạn nha.
Xin lỗi, mình không rành về cái dụ này lắm.

Cảm ơn bạn.
Tại vì nó cũng ở file send email hàng loạt tới từng người bạn ạ

duongvanminh33 · 23/9/20

Mấy Anh/Chị giúp em đoạn code này với ạ, em mới tập mày mò VBA được vài ngày, lấy code củ của mn thui ạ. Ý tưởng là muốn sử dụng một nút duy nhất để tạo ra file excel và có pass, sau đó sẽ gửi email đồng loạt luôn ạ.
Em còn gà lắm, dò lỗi mà ko hiểu sai chổ nào. Cao nhân giúp đỡ ạ.

Mã:

Sub Button4_Click()
Dim ArrData, i As Long, FName As String
Dim OutApp As Object
Dim OutMail As Object
Dim printFrom As Variant, printTo As Variant
Dim sFile As String
Dim sPath As String
Dim j As Long
Application.ScreenUpdating = False
Application.EnableEvents = False
printFrom = Sheets("Sheet3").Range("I8")
printTo = Sheets("Sheet3").Range("I9")
Set OutApp = CreateObject("Outlook.Application")
For j = printFrom To printTo
Sheets("Sheet3").Range("I5") = j
sPath = Application.ActiveWorkbook.Path
'ArrData = Sheet3.Range(Sheets("Sheet3").Range("I14"), Sheet2.Cells(&H100000, 2).End(xlUp)).Value

ArrData = Sheet2.Range(Sheet2.Cells(2, 15), Sheet2.Cells(&H100000, 2).End(xlUp)).Value

'Sheets("Sheet3").Range("A1:D33").ExportAsFixedFormat Type:=xlTypePDF, _
Filename:=sFile, _
Quality:=xlQualityStandard, _
IncludeDocProperties:=True, _
IgnorePrintAreas:=False, _
OpenAfterPublish:=False

sFile = ThisWorkbook.Path & "\Phieuluong" & Format(Now, "yyyy-mm")
Const DeleteReadOnly = True

Dim fso As Object
Set fso = CreateObject("Scripting.FileSystemObject")
If fso.FolderExists(sFile) Then
fso.DeleteFolder sFile, DeleteReadOnly
fso.CreateFolder (sFile)
End If
If Not fso.FolderExists(sFile) Then
fso.CreateFolder (sFile)
End If
For i = 1 To UBound(ArrData, 1)
Sheet3.Cells(11, 2).Value = ArrData(i, 1)
Sheets("Sheet3").Range("A2:D33").Copy
ActiveSheet.UsedRange.Value = ActiveSheet.UsedRange.Value
ActiveWorkbook.SaveAs sFile & "\" & ArrData(i, 1) & ".xlsx", , ArrData(i, 73)
ActiveWorkbook.Close False
Next
Application.EnableEvents = True
Application.ScreenUpdating = True

Set OutMail = OutApp.CreateItem(0)
With OutMail
.To = Sheets("Sheet3").Range("B12")
.CC = ""
.BCC = ""
.Subject = Sheets("Sheet3").Range("B9")
.HTMLBody = " Dear " & Sheets("Sheet3").Range("B11") & "</B> <BR><BR> Kindly find attachment payslip of December 2019. <BR>" & _
"<BR>Should you have any questions, do not hestitate to contact us." & _
"<BR><BR>Thanks & regards</B><BR>" & _
"</B>"
.Attachments.Add (sFile)
.Send
End With
Set OutMail = Nothing
Next j
Set OutApp = Nothing
Set OutMail = Nothing
MsgBox "Success"
End Sub

duongvanminh33 · 24/9/20

Làm sao để xóa bài #355 được ạ, em làm được rùi, mn có hướng dẫn từ những # bài trước. Admin có thể xóa bài này giúp mình nha. Em xin chân thành cảm ơn .

AnhThu-1976 · 24/9/20

duongvanminh33 đã viết:
Làm sao để xóa bài #355 được ạ, em làm được rùi, mn có hướng dẫn từ những # bài trước. Admin có thể xóa bài này giúp mình nha. Em xin chân thành cảm ơn .

Nếu để thì có chết thẳng Tây nào không bạn?

khaiser · 14/10/20

- Xin chào các cao nhân, mình mới tập tành thử , mà sao mình sửa các thông tin + thêm hàng (thêm nhân viên nữa) +thêm cột (danh mục lương hơn 25 cột) thi nó báo lỗi , các AC xem giúp mới. thank you

Option Explicit

'Declare Public Var
Public File_Name_Attached As String
Public shSendMail As Worksheet
Public shMailInfo As Worksheet
Public shSetup As Worksheet
Public shOutForm As Worksheet

Sub Initialization_SheetVAR()
    Set shSendMail = Sheet1
    Set shMailInfo = Sheet2
    Set shSetup = Sheet3
    Set shOutForm = Sheet4
End Sub

'Do not change the code in the functions in this module
Function Create_PDF(Myvar As Object, FixedFilePathName As String, _
                        OverwriteIfFileExist As Boolean, OpenPDFAfterPublish As Boolean) As String
    Dim FileFormatstr As String
    Dim Fname As Variant

    'Test If the Microsoft Add-in is installed
    If Dir(Environ("commonprogramfiles") & "\Microsoft Shared\OFFICE" _
         & Format(Val(Application.Version), "00") & "\EXP_PDF.DLL") <> "" Then

        If FixedFilePathName = "" Then
            'Open the GetSaveAsFilename dialog to enter a file name for the pdf
            FileFormatstr = "PDF Files (*.pdf), *.pdf"
            Fname = Application.GetSaveAsFilename("", filefilter:=FileFormatstr, Title:="Create PDF")

            'If you cancel this dialog Exit the function
            If Fname = False Then Exit Function
        Else
            Fname = FixedFilePathName
        End If

        'If OverwriteIfFileExist = False we test if the PDF
        'already exist in the folder and Exit the function if that is True
        If OverwriteIfFileExist = False Then
            If Dir(Fname) <> "" Then Exit Function
        End If

        'Now the file name is correct we Publish to PDF
        On Error Resume Next
        Myvar.ExportAsFixedFormat _
                Type:=xlTypePDF, _
                FileName:=Fname, _
                Quality:=xlQualityStandard, _
                IncludeDocProperties:=True, _
                IgnorePrintAreas:=False, _
                OpenAfterPublish:=OpenPDFAfterPublish
        On Error GoTo 0

        'If Publish is Ok the function will return the file name
        If Dir(Fname) <> "" Then Create_PDF = Fname
    End If
End Function

Sub Make_RangeOfSheet_To_PDF(File_Name As String, Range_of_Sheet As Object)
    Dim FileName, sThisFilePath, File_Name_Save_Temp As String

    If ActiveWindow.SelectedSheets.Count > 1 Then
        MsgBox "There is more then one sheet selected," & vbNewLine & _
               "be aware that every selected sheet will be published"
    End If

    'Call the function with the correct arguments
    'Tip: You can also use Sheets("Sheet3") instead of ActiveSheet in the code(sheet not have to be active then)
    sThisFilePath = ThisWorkbook.Path
    If (Right(sThisFilePath, 1) <> "\") Then sThisFilePath = sThisFilePath & "\"
    File_Name_Save_Temp = sThisFilePath & File_Name & ".pdf"
    
    FileName = Create_PDF(Range_of_Sheet, File_Name_Save_Temp, True, False)
    File_Name_Attached = File_Name_Save_Temp

    'For a fixed file name and overwrite it each time you run the macro use
    'Create_PDF(ActiveSheet, "C:\Users\Ron\Test\YourPdfFile.pdf", True, True)

    If FileName <> "" Then
        'Ok, you find the PDF where you saved it
        'You can call the mail macro here if you want
    Else
        MsgBox "Not possible to create the PDF, possible reasons:" & vbNewLine & _
               "Microsoft Add-in is not installed" & vbNewLine & _
               "You Canceled the GetSaveAsFilename dialog" & vbNewLine & _
               "The path to Save the file in arg 2 is not correct" & vbNewLine & _
               "You didn't want to overwrite the existing PDF if it exist"
    End If
End Sub

Sub Dellete_File(File_Name_Dellete As String)
   On Error Resume Next
   Workbooks(File_Name_Dellete).Close False   'it gets reopened
   Kill File_Name_Dellete
End Sub

Sub Fill_Data(RowNum As Long)
    Dim i As Long
    Dim iLastRow_shSetup As Integer
    Dim arrSetupCell() As Variant
    iLastRow_shSetup = shSetup.Cells(Rows.Count, 2).End(xlUp).Offset(0, 0).Row
 'Fill Data into Sheet "Out_Form"
    If iLastRow_shSetup >= 2 Then
        arrSetupCell = shSetup.Range("B2:C" & iLastRow_shSetup)
        For i = 1 To iLastRow_shSetup - 1
            shOutForm.Range(arrSetupCell(i, 2)).Value = shSendMail.Range(arrSetupCell(i, 1) & RowNum).Value
        Next i
    End If
End Sub

Sub Del_Data()
    Dim i As Long
    Dim iLastRow_shSetup As Integer
    Dim arrSetupCell() As Variant
    iLastRow_shSetup = shSetup.Cells(Rows.Count, 2).End(xlUp).Offset(0, 0).Row
 'Dellete Data in Sheet "Out_Form"
    If iLastRow_shSetup >= 2 Then
        arrSetupCell = shSetup.Range("B2:C" & iLastRow_shSetup)
        For i = 1 To iLastRow_shSetup - 1
            shOutForm.Range(arrSetupCell(i, 2)).Value = ""
        Next i
    End If
End Sub

khaiser · 14/10/20

& Xin các AC chỉ giúp làm 1 file excel để có thể tự gửi email chúc mừng sinh nhật cho nhân viên, khoảng 250 ngừoi với. xin cảm ơn

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

Thành viên mới

File đính kèm

Thành viên tích cực

Chỉ biết ngồi BÈ và PHÁN chuyện!!!

Thành viên gạo cội

Thành viên tích cực

Thành viên mới

File đính kèm

Thành viên tích cực

Thành viên hoạt động

Thành viên tiêu biểu

Thành viên mới

Chỉ biết ngồi BÈ và PHÁN chuyện!!!

Thành viên mới

Thành viên thường trực

Chỉ biết ngồi BÈ và PHÁN chuyện!!!

Thành viên thường trực

Thành viên mới

File đính kèm

Thành viên mới

Thành viên tích cực

Thành viên mới

File đính kèm

Thành viên mới

File đính kèm