Mail_ReceivedOrNot_Mailed मेल प्राप्त हुआ या नहीं मिला

 

Mail_ReceivedOrNot_Mailed

Formula Used:-

="\\pgarg\Pk_Sharing_Folder\OutlookSaveDSRAttachment\Delhi_Ncr\"&TEXT(Q1,"DD-MM-YYYY")&"\"&"*"

=IFERROR(@INDEX(List_Delhi_NCR,ROW()-2),"")

Sub SetReminderMail_Delhi_NCR()

Dim Sdate As String

Dim sWorkbook As Workbook

Dim sWorkbook1 As String

Dim sWorkbook2 As String

Dim wb As Workbook

Dim objApp As Object

Dim ws As Worksheet

Dim destWB As Workbook

Dim Path As String

Dim sh As Object

        

        Application.DisplayAlerts = False

        Application.ScreenUpdating = False

'Delete all file from folder temp2

        On Error Resume Next

        Kill "E:\Pkgarg_Record\Pkgarg_Final_Cril_Report\temp\*.*"

        On Error GoTo 0

'Process start

        On Error Resume Next

        Set wb = Workbooks("\Mail_ReceivedOrNot_Mailed\Mail_ReceivedOrNot_Mailed.xlsm")    'Current File

        Worksheets("Mail_Reminder").ShowAllData

        Worksheets("Mail_Reminder").RefreshAll

        On Error GoTo 0

        If Not wb Is Nothing Then

        MsgBox "It's open"

       

        'Do not have to open

        Else

        ChDir "C:\"

        Set wb = Workbooks.Open(Filename:="\Mail_ReceivedOrNot_Mailed\Mail_ReceivedOrNot_Mailed.xlsm")

        Worksheets("Mail_Reminder").AutoFilterMode = False

        wb.Activate

        End If

            

'AutoFilter Proccess

wb.Activate

'sWorkbook1 = "\MASTER_OF_OUTSTATION.xlsm"

Application.ScreenUpdating = False

ActiveSheet.AutoFilterMode = False

wb.Activate

Worksheets("Delhi_Working").AutoFilterMode = False

Worksheets("Delhi_Working").Range("A1:H100").Clear

'Sdate = Sheets("controlsheet").Range("h1")

wb.Activate

Worksheets("Mail_Reminder").Activate

Range("D2").Select

    ActiveSheet.Range("$A$2:$O$300").AutoFilter Field:=4, Criteria1:= _

        "CANTABIL DELHI NCR"

    Range("K2").Select

    ActiveSheet.Range("$A$2:$O$300").AutoFilter Field:=11, Criteria1:="0"

    Selection.End(xlToLeft).Select

    Range("A2:H2").Select

    Range(Selection, Selection.End(xlDown)).Select

    Selection.Copy

wb.Activate

Worksheets("Delhi_Working").Activate

With Worksheets("Delhi_Working").Range("A1")

.PasteSpecial xlPasteValues

.PasteSpecial xlPasteFormats

Selection.Columns.AutoFit

Application.CutCopyMode = False

 End With

        'Yha tak clear hai

Dim Fname As String

Dim i As Long

Dim signature As String

'On Error Resume Next

i = 1

Fname = Sheets("Delhi_Working").Cells(i + 1, 6).Value

Do While Fname <> Empty

wb.Activate

Fname = Sheets("Delhi_Working").Cells(i + 1, 6).Value

Application.ScreenUpdating = False

Application.DisplayAlerts = False

If Fname = "" Then

wb.Activate

MsgBox "Delhi_Ncr Mail Process Done!"

'ActiveWorkbook.Close savechanges:=False

Exit Sub

Else

If Not IsEmpty(Fname) Then

End If

End If

Dim store As String

Dim bmsg As String

Dim ML As Long

'bmsg = Sheets("controlsheet").Cells(i + 1, 1).Offset(0, 5).Value

store = Fname

Application.DisplayAlerts = False

Application.ScreenUpdating = False

'With Worksheets("Delhi_Working").Range("$A$1:$c$180")

'.AutoFilter Field:=6, Criteria1:="=" & 0

'.AutoFilter Field:=2, Criteria1:=Fname

 'End With

wb.Activate

Worksheets("Delhi_Working").Activate

'With Worksheets("Delhi_Working").Range("$A$1:$c$180")

'.AutoFilter Field:=6, Criteria1:="=" & 0

'.AutoFilter Field:=2, Criteria1:=Fname

 'End With

'Worksheets("Delhi_Working").Activate

'Worksheets("Delhi_Working").Range("A2").CurrentRegion.Select

'Worksheets("Delhi_Working").Range("A2").CurrentRegion.Copy

Application.ScreenUpdating = False

Application.DisplayAlerts = False

'Set obj = Workbooks.Add

'obj.Activate

'Paste the that copy from target file.

'With obj.Worksheets("Sheet1").Range("A1")

'.PasteSpecial xlPasteValues

'.PasteSpecial xlPasteFormats

'Selection.Columns.AutoFit

' End With

 

'Autofit the selection and delete the column

'savepath = ".xlsx": FileFormatNum = 5

'ActiveWorkbook.SaveAs Filename:="\temp2\" & Fname & savepath, FileFormat:=51

'ActiveWorkbook.Close savechanges:=True

'Set sh = Workbooks.Open(Filename:="\temp\" & Fname & savepath)

wb.Activate

Worksheets("Delhi_Working").Activate

'--for mail --

Select Case Fname

Case Fname

Dim outlookApp As Object

Dim OutlookMail As Object

Dim xlnspect As Object

Dim pageEditor As Object

Dim b As String

Dim c As String

Set outlookApp = CreateObject("Outlook.Application")

Set OutlookMail = outlookApp.CreateItem(0)

b = Worksheets("Delhi_Working").Cells(i + 1, 1).Offset(0, 10).Value

c = Worksheets("Delhi_Working").Cells(i + 1, 1).Offset(0, 5).Value

'On Error Resume Next

With OutlookMail

        

     .To = Worksheets("Delhi_Working").Cells(i + 1, 1).Offset(0, 5).Value

    .CC = Worksheets("Delhi_Working").Cells(i + 1, 1).Offset(0, 10).Value

    .Subject = "Reminder!!!! Send Your Pending Store DSR of Today, If You Have Sent Pls. Ignore It"

    .Body = "Hi" & " " & "," & vbNewLine & vbNewLine & "Reminder!!!!Store DSR did not receive till now" & vbNewLine & vbNewLine & vbNewLine & "Regards" & vbNewLine & "MIS Team"

       

    ' ActiveWorkbook.Save

    '.Attachments.Add "\temp2\" & Fname & savepath

    '.Attachments.Add ("\Desktop\PDf file\" & store & ".PDF")

    '.Display

    'Application.Wait (Now + TimeValue("00:00:08"))

    .send

End With

Set OutlookMail = Nothing

Set outlookApp = Nothing

'Application.Wait (Now + TimeValue("00:00:15"))

End Select

i = i + 1

Loop

End Sub