Gửi lương qua các địa email hàng loạt từ file temp lương (8 người xem)

Liên hệ QC

Người dùng đang xem chủ đề này

NGOCTOAN

Thành viên hoạt động
Tham gia
1/8/06
Bài viết
104
Được thích
33
Chào các Anh Chị,

Cty em có 100 nhân viên cuối mỗi tháng cần gửi thông báo lương qua Email hàng loạt từ 1 địa chỉ email của mình ( ví dụ cotuongpc@yahoo.com). từ file Mau-Luong-Email kèm đính kèm.

Khi gửi tới địa chỉ các nhân viên thì nó sắp theo chiều dọc format như sau :

Kính gửi anh/chị Lâm Huy Luật, chuc danh Nhân viên thông tin chi tiết về lương tháng này như sau

Mức lương tháng : 6.200.000
Ăn trưa : 500.000
........
........

Thực lĩnh kỳ 2 : 3131883

Cảm ơn anh/chị,



Tuần tự theo file temp lương mẫu đính kèm
Vậy nhờ Các Anh chị giúp đỡ tìm giải pháp.

Xin cảm ơn./.

Ngoctoan
 

File đính kèm

Bạn tìm bài viết về trộn in thư sau đó trèn các trường vào theo mẫu của bạn, phần cuối của trộn in thư nó có phần electronic email thì chèn trường địa chỉ email vào thì nó sẽ tự động gửi, trước khi làm việc đó bạn phải setting gửi và nhận thư trong outlook đã
 
Bạn tìm bài viết về trộn in thư sau đó trèn các trường vào theo mẫu của bạn, phần cuối của trộn in thư nó có phần electronic email thì chèn trường địa chỉ email vào thì nó sẽ tự động gửi, trước khi làm việc đó bạn phải setting gửi và nhận thư trong outlook đã

Nhờ Anh/Chị chỉ rõ hơn được không, cái này mới quá em chưa hiểu lắm.Nhưng em nghe nói có thể dùng VBA viết để gửi tự động được không nhỉ,

Xin cảm ơn./.

Ngoctoan
 
Mình viết bài này nhiều lần rồi, bạn chiu khó tìm những bài viết của mình về đề tài này để tham khảo
 
Chào Anh quanghai1969, nhờ anh tìm hộ 1 link, em tìm mãi mà chưa thấy bài nào đúng ý trên,

Xin cảm ơn.

Ngoctoan

Làm theo format trong file của bạn, nếu thay đổi định dang thì không gởi được nhé
Chú ý dòng lệnh 'SendKeys "%{s}", True , khi nào kiểm tra thấy mọi thứ đã ok thì xóa cái dấu nháy trước chữ Sendkeys thì mail sẽ được gởi đi luôn (mình không thích điều này lắm)

PHP:
Sub goi_mail()
Application.ScreenUpdating = False
Application.DisplayAlerts = False
Dim OutApp As Object, OutMail As Object
Dim FileName As String
Dim data As Range, cell As Range
Set OutApp = CreateObject("Outlook.Application")
Set data = [A1].CurrentRegion
For Each cell In Range([a2], [a2].End(4))
    data.AutoFilter 1, cell.Value
    FileName = TV(cell.Offset(, 1)) & ".xls"
    data.SpecialCells(12).Copy
    Workbooks.Add
    ActiveSheet.Paste
    With ActiveWorkbook
        .ActiveSheet.[A:Q].Columns.AutoFit
        .SaveAs ThisWorkbook.Path & "\" & FileName, FileFormat:=xlNormal
        .Close
    End With
    OutApp.Session.Logon
    Set OutMail = OutApp.CreateItem(0)
        With OutMail
            .To = cell.Offset(, 3)
            .Subject = "CHI TIET LUONG"
            .Body = "Dear " & cell.Offset(, 1) _
            & vbNewLine & vbNewLine _
            & "noi dung dong 1" _
            & vbNewLine & vbNewLine _
            & "noi dung dong 2" _
            & vbNewLine & vbNewLine _
            & "noi dung dong 3" _
            & vbNewLine & vbNewLine _
            & "Tran Trong"
            .Attachments.Add ThisWorkbook.Path & "\" & FileName
        .Display
        End With
    'SendKeys "%{s}", True
    Kill ThisWorkbook.Path & "\" & FileName
Next
data.AutoFilter
Application.ScreenUpdating = True
Application.DisplayAlerts = True
End Sub
 

File đính kèm

Làm theo format trong file của bạn, nếu thay đổi định dang thì không gởi được nhé
Chú ý dòng lệnh 'SendKeys "%{s}", True , khi nào kiểm tra thấy mọi thứ đã ok thì xóa cái dấu nháy trước chữ Sendkeys thì mail sẽ được gởi đi luôn (mình không thích điều này lắm)

PHP:
Sub goi_mail()
Application.ScreenUpdating = False
Application.DisplayAlerts = False
Dim OutApp As Object, OutMail As Object
Dim FileName As String
Dim data As Range, cell As Range
Set OutApp = CreateObject("Outlook.Application")
Set data = [A1].CurrentRegion
For Each cell In Range([a2], [a2].End(4))
    data.AutoFilter 1, cell.Value
    FileName = TV(cell.Offset(, 1)) & ".xls"
    data.SpecialCells(12).Copy
    Workbooks.Add
    ActiveSheet.Paste
    With ActiveWorkbook
        .ActiveSheet.[A:Q].Columns.AutoFit
        .SaveAs ThisWorkbook.Path & "\" & FileName, FileFormat:=xlNormal
        .Close
    End With
    OutApp.Session.Logon
    Set OutMail = OutApp.CreateItem(0)
        With OutMail
            .To = cell.Offset(, 3)
            .Subject = "CHI TIET LUONG"
            .Body = "Dear " & cell.Offset(, 1) _
            & vbNewLine & vbNewLine _
            & "noi dung dong 1" _
            & vbNewLine & vbNewLine _
            & "noi dung dong 2" _
            & vbNewLine & vbNewLine _
            & "noi dung dong 3" _
            & vbNewLine & vbNewLine _
            & "Tran Trong"
            .Attachments.Add ThisWorkbook.Path & "\" & FileName
        .Display
        End With
    'SendKeys "%{s}", True
    Kill ThisWorkbook.Path & "\" & FileName
Next
data.AutoFilter
Application.ScreenUpdating = True
Application.DisplayAlerts = True
End Sub
Anh Quang Hải có thể cho biết gửi lương từ 1 địa chỉ email ko từ outlook có làm được ko nhỉ,

Theo file anh gửi là phải buộc dùng outlook, cảm ơn Anh

Ngoc toan
 
Làm theo format trong file của bạn, nếu thay đổi định dang thì không gởi được nhé
Chú ý dòng lệnh 'SendKeys "%{s}", True , khi nào kiểm tra thấy mọi thứ đã ok thì xóa cái dấu nháy trước chữ Sendkeys thì mail sẽ được gởi đi luôn (mình không thích điều này lắm)

PHP:
Sub goi_mail()
Application.ScreenUpdating = False
Application.DisplayAlerts = False
Dim OutApp As Object, OutMail As Object
Dim FileName As String
Dim data As Range, cell As Range
Set OutApp = CreateObject("Outlook.Application")
Set data = [A1].CurrentRegion
For Each cell In Range([a2], [a2].End(4))
    data.AutoFilter 1, cell.Value
    FileName = TV(cell.Offset(, 1)) & ".xls"
    data.SpecialCells(12).Copy
    Workbooks.Add
    ActiveSheet.Paste
    With ActiveWorkbook
        .ActiveSheet.[A:Q].Columns.AutoFit
        .SaveAs ThisWorkbook.Path & "\" & FileName, FileFormat:=xlNormal
        .Close
    End With
    OutApp.Session.Logon
    Set OutMail = OutApp.CreateItem(0)
        With OutMail
            .To = cell.Offset(, 3)
            .Subject = "CHI TIET LUONG"
            .Body = "Dear " & cell.Offset(, 1) _
            & vbNewLine & vbNewLine _
            & "noi dung dong 1" _
            & vbNewLine & vbNewLine _
            & "noi dung dong 2" _
            & vbNewLine & vbNewLine _
            & "noi dung dong 3" _
            & vbNewLine & vbNewLine _
            & "Tran Trong"
            .Attachments.Add ThisWorkbook.Path & "\" & FileName
        .Display
        End With
    'SendKeys "%{s}", True
    Kill ThisWorkbook.Path & "\" & FileName
Next
data.AutoFilter
Application.ScreenUpdating = True
Application.DisplayAlerts = True
End Sub

Anh ơi, em run code nó gửi mail ok nhưng bên code nó bị lỗi, với thông báo:
run-time error '1004;:

Method'SaveAs' of object'Workbook' faliled

Anh xem lại giúp em nhé !

Em cảm ơn !
 
Anh ơi, em run code nó gửi mail ok nhưng bên code nó bị lỗi, với thông báo:


Anh xem lại giúp em nhé !

Em cảm ơn !
Em xin gửi ảnh đính kèm thông báo lỗi, mong các thầy và các anh chị giúp đỡ thêm ạ.
57068904.gpe1.png


Em xin cảm ơn !
 
Lần chỉnh sửa cuối:
Trước mình xài toàn viết letter dạng word rồi liên kết với file excel rồi Mail merge gửi mail qua Outlook
Nếu những cách kia khó thì bạn thể kiểu này xem. Mình thấy nó dễ dàng hơn nhiều.
 
Trước mình xài toàn viết letter dạng word rồi liên kết với file excel rồi Mail merge gửi mail qua Outlook
Nếu những cách kia khó thì bạn thể kiểu này xem. Mình thấy nó dễ dàng hơn nhiều.

Do phải thao tác với con số và tính toán nhiều với những yêu cầu khá phức tạp nên bắt buộc em phải dùng excel.
Vì thế, trong trường hợp này giải pháp dùng mail merge bằng word không được khả thi cho lắm.

File cụ thể các Thầy và các anh chị xem ở bài số #8:

Mong mọi người giúp đỡ thêm ạ.
Em xin trân trọng cảm ơn !
 
Code hữu dụng nên em có đang vận dụng cho công việc thực tế.
Tuy có gửi được mail nhưng mỗi khi gửi xong code vẫn bị lỗi như em trình bày ở bên trên nên có đôi chút khó chịu !

Mong các Thầy và các anh chị giúp đỡ thêm.
Trân trọng.
 
Lần chỉnh sửa cuối:
Xin chào,
Mình tìm được đoạn code thế này thấy chạy khá ổn. tuy nhiên mình muốn phần nội dung email cũng thay đổi theo thì chưa làm được. Mong các cao thủ xem và chỉ giáo giúp:

Sub Send_Mail()
'Working in 2000-2010
Dim FileExtStr As String
Dim FileFormatNum As Long
Dim Sourcewb As Workbook
Dim Destwb As Workbook
Dim TempFilePath As String
Dim TempFileName As String
Dim OutApp As Object
Dim OutMail As Object
Dim Signature As String
Dim cont As String
Dim ct1 As String, ct2 As String, ct3 As String
Dim i As Integer, n As Integer

ct1 = Trim(Sheets("Set_up").Range("F12").Value)
ct2 = Trim(Sheets("Set_up").Range("F13").Value)
ct3 = Trim(Sheets("Set_up").Range("F14").Value)

cont = ct1 & ct2 & ct3

Sheets("Set_up").Select
Range("I8").Select
Range(Selection, Selection.End(xlDown)).Select
n = Selection.Count

Sheets("Set_up").Select
Range("Group").Select

For i = 1 To n
Group = Trim(Sheets("Set_up").Cells(i + 7, 9).Value)
Sheets("Set_up").Range("Group").Value = Group

Set OutApp = CreateObject("Outlook.Application")
Set OutMail = OutApp.CreateItem(olMailItem)
With OutMail
.Display
End With
Signature = OutMail.htmlBody

On Error Resume Next

With OutMail
.To = Trim(Sheets("Set_up").Range("Recipient").Value)
.cc = Trim(Sheets("Set_up").Range("Cc").Value)
.Subject = Trim(Sheets("Set_up").Range("Subject").Value)
.htmlBody = cont & Signature
.Attachments.Add Trim(Sheets("Set_up").Range("PathFile").Value)
'.Display
.Send
End With
On Error GoTo 0

Set OutMail = Nothing
Set OutApp = Nothing


With Application
.ScreenUpdating = True
.EnableEvents = True
End With
Next i
MsgBox ("Send Mail Completed!")
End Sub
 

File đính kèm

Web KT

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

Back
Top Bottom