Account Co ordinator | To | CC | Add Attachement |
A | A@gmail.com | C:\Users\Vinay Kumar\Desktop\VBA Classs\Odata\A.xlsx | |
B | B@gmail.com | C:\Users\Vinay Kumar\Desktop\VBA Classs\Odata\B.xlsx | |
C | C@gmail.com | C:\Users\Vinay Kumar\Desktop\VBA Classs\Odata\C.xlsx | |
D | D@gmail.com | C:\Users\Vinay Kumar\Desktop\VBA Classs\Odata\D.xlsx | |
E | E@gmail.com | C:\Users\Vinay Kumar\Desktop\VBA Classs\Odata\E.xlsx |
Option Explicit
'Code to segregate Master raw data file based on Name and send it to respected owner
Sub outlook_automation()
Dim i As Integer
Dim path As String
Dim wb As Workbook
Dim fldg As FileDialog
Application.ScreenUpdating = False 'Restricted from screen updation
'Selection of Master file
Set fldg = Application.FileDialog(msoFileDialogOpen)
fldg.Show
fldg.Execute
path = fldg.SelectedItems(1) 'Path of selected file
'Intializing workbook
Set wb = Workbooks.Open(path)
For i = 8 To 12
'Segregation of data basis name
wb.Sheets(1).Range("A1").CurrentRegion.AutoFilter field:=1, _
Criteria1:=ThisWorkbook.Sheets("sheet9").Range("C" & i).Value
'Addition of new workbook and save basis name
Workbooks.Add.SaveAs ("C:\Users\Vinay Kumar\Desktop\VBA Classs\Odata\" & _
ThisWorkbook.Sheets("sheet9").Range("C" & i).Value & ".xlsx")
'Copying data basis name
wb.Sheets(1).Range("A1").CurrentRegion.Copy
'Paste in new workbook basis name
Workbooks(ThisWorkbook.Sheets("sheet9").Range("C" & i).Value) _
.Sheets("sheet1").Range("A1").PasteSpecial
'Adding attachement path
ThisWorkbook.Sheets("Sheet9").Range("F" & i).Value = _
Workbooks(ThisWorkbook.Sheets("sheet9").Range("C" & i).Value).path & "\" & _
ThisWorkbook.Sheets("sheet9").Range("C" & i).Value & ".xlsx"
'Closing of workbook basis name
Workbooks(ThisWorkbook.Sheets("sheet9").Range("C" & i).Value) _
.Sheets("sheet1").Range("A1").Select 'Range("A1") selection
Workbooks(ThisWorkbook.Sheets("sheet9").Range("C" & i).Value).Close True 'Closong of workbook with save
Next
Application.CutCopyMode = False
Workbooks("Raw data").Close False
'Phase2
'--------------------------------------------
Dim OApp As Outlook.Application
Dim OEmail As Outlook.MailItem
Set OApp = New Outlook.Application
For i = 8 To 12
Set OEmail = OApp.CreateItem(olMailItem)
With OEmail
.Display
.To = ThisWorkbook.Sheets("sheet9").Range("D" & i).Value
.CC = "kvinay.g@gmail.com"
.Subject = "Please find attached"
.Body = "Test mail"
.Attachments.Add (ThisWorkbook.Sheets("sheet9").Range("F" & i).Value)
' .Save
.Close olSave
End With
Next
Application.ScreenUpdating = True
MsgBox "done!!"
End Sub
Guys, Please put your comments. Hope you are liking it..
ReplyDelete