min min là bài tập in phiếu lương hàng loạt mình có thể ứng dụng thêm

Chào bạn hoàn toàn có thể làm được bạn nhé, bước 1 bạn xuất file ra một thư mục và với mỗi email sẽ gắn active file nhé. 

Chào bạn bạn làm như sau

B1: Xuất file in hàng loạt ra dạng pdf ở thư mục với tên chỉ định(theo tên nv)

B2: Dùng vòng lặp theo tên chỉ định đó lấy ra email và link gửi phiếu lương

B3 active file và gửi email nhé.

Admin cho mình hỏi đoạn code bôi vàng bên dưới, lấy file attach theo tên chỉ định (sau khi đã lưu file PDF vào thư mục) viết như nào được ạ? giả sử ô I13 mình đã Vlookup Email theo mã nhân viên.

Thank admin

chào bạn phần tên file đã xuất hiện chưa nhỉ? bạn xem ví dụ sau nhé

https://stackoverflow.com/questions/5...

Public Sub AttachFileToEmail()

    Dim OutApp As Object
    Dim OutMail As Object
    Dim sourceTable As ListObject
    Dim evalRow As ListRow

    Dim counter As Long
    Dim toArray() As Variant

    Dim strDir As String
    Dim file_name_import As String
    Dim fName As String

    Application.ScreenUpdating = False

    Set OutApp = CreateObject("Outlook.Application")

    ' Excel details not recreated, not needed for this question

    file_name_import = Format(Now, "yyyy-mm-dd hh-mm-ss")
    file_name_import = file_name_import & " - File 1.xlsx"

    ' Subscript out of range error would be bypassed due to poor error handling
    'Worksheets("Sheet 1").Copy
    Worksheets("Sheet1").Copy

    ' Trailing backslash error would be bypassed due to poor error handling
    'ChDir "H:\Folder 1\Folder 2\Folder 3\Folder 4\"

    strDir = "C:\Folder 1\Folder 2\Folder 3\Folder 4\"
    Debug.Print strDir

    ' Backslash already at end of strDir
    fName = strDir & "File 1" & file_name_import
    Debug.Print fName

    ActiveWorkbook.SaveAs FileName:=fName, FileFormat:=xlOpenXMLWorkbook, CreateBackup:=False

    ' Setup the email
    Set OutMail = OutApp.CreateItem(0)

    ' Do not use On Error Resume Next without a specific reason for bypassing errors
    ' Instead fix the errors now that you can see them

    With OutMail

        ' Excel details not recreated, not needed for this question

        .Subject = "Reminder"

        .Body = "Dear All" _
                & vbNewLine & vbNewLine & _
                "Please comply with the transfers in the attached file. " & _
                "Look up for your store and process asap."

        .Attachments.Add fName

        .Display

    End With

    Set OutMail = Nothing

cleanup:
    Set OutApp = Nothing
    Application.ScreenUpdating = True

End Sub

Cảm ơn admin mình làm được rồi nhé ^^

chúc bạn học tốt cùng gitiho