[Help] – Kiểm Tra Và Giúp Đỡ Về Gởi Email Bảng Lương Có Đặt Mật Khẩu

Chia sẻ bởi:hands

★★★★★

‹ Bản ghi giờ làm hàng tuần cho... Cách tạo Phiếu lương gửi nhân viên... ›

Quảng cáo

Xin chào A/C/E của diễn đàn GPE và chúc mọi người một ngày tuyệt vời,
Mình đang tự mày mò kiến thức trên diễn đàn để làm một form để gởi bảng lương có đặt mật khẩu từ một sheet trong file master.
Tuy nhiên, do mày mò nên mình không biết nó sai và bị lỗi ở đoạn nào ?
Nhờ A/C/E có kinh nghiệm kiểm tra và giúp đỡ giúp. Cám ơn A/C/E rất nhiều.

Mục đích chính của mình là :
Có 1 file master bao gồm danh sách bảng lương của mỗi nhân viên(mỗi nhân viên là một sheet) => Mình muốn làm một form gởi email tự động.
Khi gởi mail cho nhân viên nào thì sẽ copy bảng lương của nhân viên đó tạo thành một file excel đính kèm của email và đặt mật khẩu theo quy định(giả sử lấy theo ID nhân viên).
Code mình làm như bên dưới, tuy nhiên nó không gọi được Outlook và không gởi email được.
p/s : cho mình hỏi ngu thêm chút nữa là : từ excel có code nào export được tạo ra file pdf mà có đặt được mật khẩu của file pdf đó ko ? mình tìm cách export này mà ko ra

Sub Send_Mail()
  Dim stFileName As String
  Dim fFile As String
  Dim stSubject As String
  Dim stMailContent As String
  Dim vaTo As Variant
  Dim vaCopyTo As Variant
  Dim vaBlindCopyTo As Variant
  Dim emailAlias As String
  Dim vaEnclosure As Variant
  Dim vaDisplayFrom As Variant
  Dim OutApp As Object
  Dim OutMail As Object
  Dim sPwd        As String
  Dim AgencyList  As ListObject
  Dim Agent       As ListRow
  Application.ScreenUpdating = False
  Set OutApp = CreateObject("Outlook.Application")

On Error Resume Next

Set AgencyList = ActiveWorkbook.Worksheets("AgencyList").ListObjects("AgencyListTable")
  If AgencyList.DataBodyRange Is Nothing Then
        MsgBox "No Agent"
        Exit Sub
  End If

stSubject = Sheets("Form_SendMail").Range("MailSubject").Value

stMailContent = Sheets("Form_SendMail").Range("MailContent").Value

'emailAlias = Sheets("Form_SendMail").Range("EmailAlias").Value

For Each Agent In AgencyList.ListRows

If Agent.Range.Columns(4).Value Like "?*@?*.?*" And _
           LCase(Agent.Range.Columns(5).Value) = "x" Then
            On Error Resume Next
            Agent.Add
                If Err.Number = 0 Then
                    vaTo = Agent.Range.Columns(4).Value
                    MsgBox vaTo
                    stFileName = Agent.Range.Columns(6).Value
                    vaCopyTo = Agent.Range.Columns(7).Value
                    fFile = Environ("temp") & "" & Agent.Range.Columns(6).Value & "_Payslip of " & MonthName(Month(Range("PayslipDate").Value), True) & " - " & Year(Range("PayslipDate").Value) & ".xlsx"
                    ActiveWorkbook.Worksheets(Agent.Range.Columns(6).Value).Copy
                    ActiveWorkbook.SaveAs _
                    Filename:=stFileName, _
                    FileFormat:=xlWorkbookDefault, _
                    Password:=Agent.Range.Columns(2).Value, _
                    WriteResPassword:=Agent.Range.Columns(2).Value
                    '------

Set OutMail = OutApp.CreateItem(0)

With OutMail

.To = vaTo
                            '.SentOnBehalfOfName = emailAlias
                            '-------------------------------

.CC = vaCopyTo
                            '.Bcc = vaBlindCopyTo
                            '-------------------------------
                            .Subject = stSubject
                            '---------------------------- ---
                            .Body = stMailContent
                            '-------------------------------
                            .Attachments.Add fFile
                            .Display
                            .Send

.SaveMessageOnSend = True
                            .PostedDate = Now()
                            .Send 0, vaTo
                          End With
                          Kill fFile
                  Set OutMail = Nothing
                End If

On Error GoTo 0

End If

Next

With Application
        .ScreenUpdating = True
        .EnableEvents = True
End With

MsgBox "Done!", vbInformation
End Sub

Tôi nghĩ trước hết bạn tìm trong GPE lấy 1 sub VBA chuẩn về việc gửi mail bằng Outlook. Gửi cho được mail có đường dẫn file có sẵn đã, sau đó mới dần dần sửa code để gửi cho file mới tạo. Làm từng bước vững chắc chứ không là vấp.

Cám ơn bạn @Maika8008 .
Phần Sub gởi mail theo đường dẫn như bạn đề cập tôi làm được rồi.
Tuy nhiên do nhu cầu tôi muốn lưu một file master(sau khi đã gởi mail) bao gồm toàn bộ payslip của nhân viên(thay vì lưu theo từng payslip riêng lẻ) nên mới nghĩ cách để làm theo hướng này.
Phần code tôi đưa ra cũng là được sửa từ Sub gởi mail đính kèm file theo đường dẫn nhưng chưa thành công.

Tôi không xem code gửi mail của bạn nên không biết sai ở đâu nhưng tôi gửi cho bạn code khác có thể chèn chữ ký, chèn ảnh. Tôi đã chạy thử rất tốt. Code này tôi lấy từ GPE ở thớt nào không nhớ, có ghi chú tiện cho việc hiểu và sửa đổi khi cần. Các hàm có trong module Setup là cần thiết để định dạng html cho chữ ký.