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