Xin code gửi mail có đính kèm (1 người xem)

[tranquangtrung87]

Kính gửi các anh/chị,
Em tìm được code tách file từ file tổng như sau:
Sub Tachfile()
Dim iColumn As Integer
iColumn = 1 'Chon cot can tach'
iRow = 5 'Chon dong header'
Dim wb As Workbook
Dim ThisSheet As Worksheet
Dim NumOfColumns As Integer
Dim RangeToCopy As Range

Dim WorkbookCounter As Integer
Dim Temp As String
Set myRangeToCopy = CreateObject("System.Collections.ArrayList")
Set myList = CreateObject("System.Collections.ArrayList")
Set myListWb = CreateObject("System.Collections.ArrayList")



Application.ScreenUpdating = False


Set ThisSheet = ThisWorkbook.ActiveSheet
NumOfColumns = ThisSheet.UsedRange.Columns.Count
WorkbookCounter = 1
For p = iRow + 1 To ThisSheet.UsedRange.Rows.Count Step 1



Dim isExist As Boolean
isExist = False
Dim iCount As Integer
For iCount = 0 To myList.Count - 1 Step 1
Set strTest = ThisSheet.Cells(p, iColumn)
If (myList.Item(iCount) = ThisSheet.Cells(p, iColumn)) Then
isExist = True
Exit For
End If
Next

If (isExist = False) Then
Set wb = Workbooks.Add
myListWb.Add wb
myList.Add ThisSheet.Cells(p, iColumn)

Set RangeToCopy = ThisSheet.Range(ThisSheet.Cells(1, 1), ThisSheet.Cells(iRow, NumOfColumns))
RangeToCopy.Copy wb.Sheets(1).Range("A" & wb.Sheets(1).UsedRange.Rows.Count)


Set RangeToCopy = ThisSheet.Range(ThisSheet.Cells(p, 1), ThisSheet.Cells(p, NumOfColumns))
RangeToCopy.Copy wb.Sheets(1).Range("A" & wb.Sheets(1).UsedRange.Rows.Count + 1)

Else
Set wb = myListWb.Item(iCount)
Set RangeToCopy = ThisSheet.Range(ThisSheet.Cells(p, 1), ThisSheet.Cells(p, NumOfColumns))
RangeToCopy.Copy wb.Sheets(1).Range("A" & wb.Sheets(1).UsedRange.Rows.Count + 1)

End If

Next p

Workbooks.Application.DisplayAlerts = False


For p = 0 To myListWb.Count - 1 Step 1
Set wb = myListWb.Item(p)

For iColumn = 1 To 45 Step 1
wb.Worksheets("Sheet1").Columns(iColumn).ColumnWidth = ThisSheet.Columns(iColumn).ColumnWidth
Next

'wb.SaveAs ThisWorkbook.Path & "\Current\" & myList.Item(p)'
'Tao thu muc chua cac file da tach, mac dinh "\"'

Set fso = CreateObject("Scripting.FileSystemObject")

' Tao thu muc Output
Dim output As String
output = "Output" 'Doi ten o day
Dim exist As Boolean
exist = fso.FolderExists(ThisWorkbook.Path & "\" & output)
If (exist = False) Then
Set f = fso.CreateFolder(ThisWorkbook.Path & "\" & output)
End If


wb.SaveAs ThisWorkbook.Path & "\" & output & "\" & myList.Item(p) & "_" & Format(DateTime.Now, "yyyyMMddhhmm")

wb.Close
Next

Application.ScreenUpdating = True
Set wb = Nothing
End Sub

Kính nhờ các bác giúp em là khi tách file xong rồi gửi mail luôn đính kèm cái file mình tách tương ứng với email trong danh sách thì làm thế nào ạ
Em cám ơn nhiều ạ

 

[tranquangtrung87]

Hix, các bác giúp em với ạ

 

[Trường An Nguyễn]

Bạn xem thử. Cần phải cài Email qua Outlook nhé.