Xin giúp đỡ code gửi mail cho từng cá nhân (1 người xem)

  • Thread starter Thread starter LYSM
  • Ngày gửi Ngày gửi
Liên hệ QC

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

LYSM

Thành viên thường trực
Tham gia
16/3/11
Bài viết
290
Được thích
26
Em chào các anh chị! Em có file gửi mail cho từng cá nhân, nhưng file attach được copy ra có định dạng không giống file gốc (độ cao của dòng, định dạng chiều ngang khi in v.v..). Nhờ các anh chị giúp em làm sao copy toàn bộ định dạng của file gốc (độ rộng cột, chiều cao hàng, định dạng khi in v.v..) vì công ty em nhiều người, mỗi người chỉnh một kiểu nhìn chẳng ra làm sao cả. Em cảm ơn nhiều!
Em có copy code để các anh chị xem nhanh ạ

Public Sub Sent_Mail()
Dim OutApp As Object
Dim OutMail As Object
Dim FileName As String
Dim Ws As Worksheet
Application.ScreenUpdating = 0
Application.DisplayAlerts = False
Set OutApp = CreateObject("Outlook.Application")
For Each Ws In ThisWorkbook.Worksheets
If Ws.[H1] <> NullString Then
FileName = "PA thang " & Month(Date - 15) & "_" & Ws.Name & ".xls"
Ws.[A:H].Copy 'khi chuyển dòng này thành Ws.copy thì nó lại ra một đống sheet thừa
Workbooks.Add
ActiveSheet.Paste
With ActiveWorkbook
.SaveAs ThisWorkbook.Path & "\" & FileName, FileFormat:=xlNormal
.Close
End With
OutApp.Session.Logon
Set OutMail = OutApp.CreateItem(0)
With OutMail
.To = Ws.[H1]
.Subject = "PA thang " & Month(Date - 15)
.Body = Sheet1.[T1] & cell & vbNewLine & Sheet1.[T2] & vbNewLine _
& Sheet1.[T3] & vbNewLine & Sheet1.[T4]
.Attachments.Add ThisWorkbook.Path & "\" & FileName
.display
End With
CreateObject("Scripting.FileSystemObject").DeleteFile ThisWorkbook.Path & "\" & FileName
End If
Next
Application.ScreenUpdating = 1
Application.DisplayAlerts = 1
End Sub
 

File đính kèm

Web KT

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

Back
Top Bottom