VBA Coding : For Sharing data by Email With Attachment using Excel data in other Place

' We have some data in Excel that we want to share by email with attachment
हमारे पास Excel में कुछ डेटा हैं जिन्हें हम अनुलग्नक के साथ ईमेल द्वारा साझा करना चाहते हैं

Sub For_GSTR3B_Report_Share()


Dim sWorkbook1 As Workbook
Dim wb As Workbook
Dim objApp As Object  'For New Workbook
Dim ws As Worksheet
Dim savepath As String

        'Delete all file from folder temp2
        On Error Resume Next
        Kill "C:\Users\PRAMOD.GARG\Desktop\pk_temp*.*"
        On Error GoTo 0
     
        On Error Resume Next
        Set wb = Workbooks("Pkgarg_Control_Sheet_With_Gaurav_Coding.xlsm")
        On Error GoTo 0
        If Not wb Is Nothing Then
        MsgBox "It's open"
        wb.Activate
        Worksheets("For_GSTR3B_Report_Share").Activate
     
        'Do not have to open
     
        Else
        ChDir "C:\"
        Worksheets("For_GSTR3B_Report_Share").Activate
        Set wb = Workbooks.Open(Cells(16, 3))
        wb.Activate
        End If
         
Dim fname As String
Dim i As Long
Dim signature As String

'On Error Resume Next
i = 1
fname = Sheets("For_GSTR3B_Report_Share").Cells(i + 1, 1).Value

Do While fname <> Empty
wb.Activate
fname = Sheets("For_GSTR3B_Report_Share").Cells(i + 1, 1).Value

Application.ScreenUpdating = True
Application.DisplayAlerts = True



If fname = "" Then
sWorkbook1.Activate
ActiveWorkbook.Close savechanges:=True
Exit Sub
Else
If Not IsEmpty(fname) Then
End If
End If


Dim store As String
Dim bmsg As String
bmsg = Sheets("For_GSTR3B_Report_Share").Cells(i + 1, 1).Offset(0, 2).Value
store = fname

Application.DisplayAlerts = True
Application.ScreenUpdating = True

'AutoFilter Proccess
wb.Activate
Set sWorkbook1 = Workbooks.Open(Cells(12, 3))
Application.ScreenUpdating = True
ActiveSheet.AutoFilterMode = False
sWorkbook1.Activate
With Worksheets("Sheet2").Range("$a$1:$s$215")
'.AutoFilter Field:=56, Criteria1:=Sheets("Sheet1").Range("f3")
     
'.AutoFilter Field:=57, Criteria1:=Sheets("Sheet1").Range("f5")
.AutoFilter Field:=1, Criteria1:=fname
 End With

'Workbooks("MASTER OF OUTSTATION IST QTR. demo.xlsm").Worksheets("JULY-SEPT").Activate
Worksheets("Sheet2").Activate
Worksheets("Sheet2").Range("A1").CurrentRegion.Select
Worksheets("Sheet2").Range("A1").CurrentRegion.Copy
Application.DisplayAlerts = False
Application.ScreenUpdating = False
Set objApp = Workbooks.Add
objApp.Activate

'Paste the that copy from target file.
With objApp.Worksheets("Sheet1").Range("A1")
.PasteSpecial xlPasteValues
.PasteSpecial xlPasteFormats
 End With

'Autofit the selection and delete the column
Application.DisplayAlerts = False
Application.ScreenUpdating = False

Selection.Columns.AutoFit

savepath = ".xlsx": FileFormatNum = 5
ActiveWorkbook.SaveAs Filename:="C:\Users\PRAMOD.GARG\Desktop\pk_temp\" & fname & savepath, FileFormat:=51
ActiveWorkbook.Close savechanges:=True

'Set sh = Workbooks.Open(Filename:="\\pgarg\PKGARG_REPORT_WITH_GAURAV\temp\" & Fname & savepath)
Application.DisplayAlerts = False
Application.ScreenUpdating = False
wb.Activate
'--for mail --
Select Case fname
Case fname
Dim outlookapp As Object
Dim outlookmail As Object
Dim xlnspect As Object
Dim pageEditor As Object

Set outlookapp = CreateObject("Outlook.Application")
Set outlookmail = outlookapp.createitem(0)


'On Error Resume Next
With outlookmail
     
    .to = Worksheets("For_GSTR3B_Report_Share").Cells(i + 1, 1).Offset(0, 2).Value
    .cc = Worksheets("For_GSTR3B_Report_Share").Cells(i + 1, 1).Offset(0, 3).Value
    .Subject = "GSTR3B as on 30.11.2019"
    .body = "Dear Sir" & " " & "," & vbNewLine & vbNewLine & "PFA related to GSTR3B as on 30.11.2019." & vbNewLine & "Kindly Update accordingly" & vbNewLine & vbNewLine & "Regards" & vbNewLine & "Pramod Garg"
     
    ' ActiveWorkbook.Save
    .Attachments.Add "C:\Users\PRAMOD.GARG\Desktop\pk_temp\" & fname & savepath
    '.Attachments.Add ("C:\Users\Manish Dawan\Desktop\PDf file\" & store & ".PDF")
    .display
    '.send
 

'ActiveWorkbook.Close savechanges:=True

End With
Set outlookmail = Nothing
Set outlookapp = Nothing


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


End Select
i = i + 1

Loop


'Application.DisplayAlerts = False
End Sub