Saturday, March 18, 2017

File Distribution and send mail


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

1 comment:

  1. Guys, Please put your comments. Hope you are liking it..

    ReplyDelete

*INTERVIEW QUESTIONS

* Ques 01. What is the difference between ByVal and ByRef and which is default ? Ans-  ByRef : If you pass an argument by reference when...