Search mail in outlook with a particular word in the subject and read the message in the mail line by lines using VBA,VBA Teacher Sourav,Kolkata 09748184075

Sub CloseOutlook()
Dim OL As Object
On Error Resume Next
Set OL = GetObject(, "Outlook.Application")
On Error GoTo 0
If OL Is Nothing Then
MsgBox "Outlook is not running!"
Else
OL.Quit
End If
End Sub


 Sub Search_Inbox()
 'Trying to close outlook first

 CloseOutlook


Dim myOlApp As New Outlook.Application
Dim myNameSpace As Outlook.Namespace
Dim myInbox As Outlook.MAPIFolder
Dim myitems As Outlook.Items
Dim myItem As Object
Dim Found As Boolean
Dim atmt As Outlook.Attachment
Dim MyAr() As String
On Error Resume Next

Set myNameSpace = myOlApp.GetNamespace("MAPI")
Set myInbox = myNameSpace.GetDefaultFolder(olFolderSentMail)
Set myitems = myInbox.Items
Found = False

For Each myItem In myitems
    If myItem.Class = olMail Then
        If InStr(1, myItem.Subject, "macro") > 0 Then
            'MsgBox ("Found")
            For Each atmt In myItem.Attachments

If atmt.FileName = "macro.txt" Then
atmt.SaveAsFile "D:\" & atmt.FileName

MyAr = Split(myItem.Body, vbCrLf)

For i = LBound(MyAr) To UBound(MyAr)
    '~~> This will give you the contents of your email
    '~~> on separate lines
    MsgBox (MyAr(i))
Next i
MsgBox ("Done")

End If



Next
            Found = True
        End If
    End If
Next myItem

'If the subject isn't found:
If Not Found Then
   ' NoResults.Show
End If

myOlApp.Quit
Set myOlApp = Nothing

End Sub

find mail based on words in subject in outlook and save their attachments,VBA Teacher Sourav,Kolkata 09748184075

Sub Search_Inbox()

Dim myOlApp As New Outlook.Application

Dim myNameSpace As Outlook.Namespace

Dim myInbox As Outlook.MAPIFolder

Dim myitems As Outlook.Items

Dim myitem As Object

Dim Found As Boolean

Dim atmt As Outlook.Attachment

Set myNameSpace = myOlApp.GetNamespace("MAPI")

Set myInbox = myNameSpace.GetDefaultFolder(olFolderInbox)

Set myitems = myInbox.Items

Found = False

For Each myitem In myitems

    If myitem.Class = olMail Then

        If InStr(1, myitem.Subject, "macro") > 0 Then

            'MsgBox ("Found")

            For Each atmt In myitem.Attachments

If atmt.Filename = "macro.txt" Then

atmt.SaveAsFile "F:\" & atmt.Filename

End If

Next

            Found = True

        End If

    End If

Next myitem

'If the subject isn't found:

If Not Found Then

    NoResults.Show

End If

myOlApp.Quit

Set myOlApp = Nothing

End Sub


Source:Stackoverflow

Open a workbook in a directory,filter the data based on criteria,copy the filtered data in a different workbook,automating daily office work using VBA,VBA teacher Sourav,Kolkata 09748184075

Option Explicit




Sub LoopAllExcelFilesInFolder()

'PURPOSE: To loop through all Excel files in a user specified folder and perform a set task on them
'SOURCE: www.TheSpreadsheetGuru.com

Dim wb As Workbook
Dim myPath As String
Dim myFile As String
Dim myExtension As String
Dim FldrPicker As FileDialog
Dim N As Long
'First trying to close the file if it is already open
On Error Resume Next

Workbooks("data.xlsm").Close SaveChanges:=True

'Optimize Macro Speed
  Application.ScreenUpdating = False
  Application.EnableEvents = False
  Application.Calculation = xlCalculationManual

'Retrieve Target Folder Path From User
  Set FldrPicker = Application.FileDialog(msoFileDialogFolderPicker)

    With FldrPicker
      .Title = "Select A Target Folder"
      .AllowMultiSelect = False
        If .Show <> -1 Then GoTo NextCode
        myPath = .SelectedItems(1) & "\"
    End With

'In Case of Cancel
NextCode:
  myPath = myPath
  If myPath = "" Then GoTo ResetSettings

'Target File Extension (must include wildcard "*")
  myExtension = "data.xls*"

'Target Path with Ending Extention
  myFile = Dir(myPath & myExtension)

'Loop through each Excel file in folder
  Do While myFile <> ""
    'Set variable equal to opened workbook
      Set wb = Workbooks.Open(FileName:=myPath & myFile)
   
    'Ensure Workbook has opened before moving on to next line of code
      DoEvents
   
    'Change First Worksheet's Background Fill Blue
      wb.Worksheets(1).Range("A1:Z1").Interior.Color = RGB(51, 98, 174)
     
      'Let's try the autofiltering
        ActiveWorkbook.Sheets("Sheet1").Activate
     
      
        On Error Resume Next
   
        ActiveWorkbook.ActiveSheet.ShowAllData
  
        ActiveSheet.Range("A1").AutoFilter Field:=35, Criteria1:= _
        "August 2015"
       
       
     
        N = Range("AI" & Rows.count).End(xlUp).Row
        Range("AI2:AI" & N).Select
        Selection.Copy
    'Save and Close Workbook
      wb.Close SaveChanges:=True
     
        'now let's see if the workbook where the filtered data to be pasted is open or not
       
         Dim status As Boolean

         status = IsWorkBookOpen("C:\Users\sourav\Desktop\filter_final_RD.xlsx")
         If status = False Then

         Workbooks("C:\Users\sourav\Desktop\filter_final_RD.xlsx").Open
         End If
        
         Workbooks("C:\Users\sourav\Desktop\filter_final_RD.xlsx").Activate
         ActiveWorkbook.Sheets("DATABASE").Select
         Range("AJ3").Select
         ActiveSheet.Paste
        
       
         Application.CutCopyMode = False
         wb.Activate
        
        

     
    'Ensure Workbook has closed before moving on to next line of code
      DoEvents

    'Get next file name
      myFile = Dir
  Loop

'Let/'s try the filtering

'Message Box when tasks are completed
  MsgBox "Task Complete!"

 Workbooks("C:\Users\sourav\Desktop\filter_final_RD.xlsx").Activate
         ActiveWorkbook.Sheets("DATABASE").Select
ActiveWorkbook.Save

ResetSettings:
  'Reset Macro Optimization Settings
    Application.EnableEvents = True
    Application.Calculation = xlCalculationAutomatic
    Application.ScreenUpdating = True



End Sub

Function IsWorkBookOpen(FileName As String)
    Dim ff As Long, ErrNo As Long

    On Error Resume Next
    ff = FreeFile()
    Open FileName For Input Lock Read As #ff
    Close ff
    ErrNo = Err
    On Error GoTo 0

    Select Case ErrNo
    Case 0:    IsWorkBookOpen = False
    Case 70:   IsWorkBookOpen = True
    Case Else: Error ErrNo
    End Select
End Function

Download certain indexed videos from a playlist in youtube using youtube-dl,Computer Teacher Sourav,Kolkata 09748184075

Suppose there is a playlist in youtube and you want to download videos indexed at 7 to 9(the indexing starts at 1),the command should be

pip -install youtube-dl

traverse to the directory in command line where you want to save the files  


youtube-dl --playlist-start=7 --playlist-end=9 -ci 
https://www.youtube.com/playlist?list=PLQVvvaa0QuDc2QjQOkZ4rtLYZVll_sZFZ

Windows Resource Protection found corrupt files but was unable to fix some of them fixed,Computer Teacher Sourav,Kolkata 09748184075

when running sfc /scannow i am presented with an error called

" Windows Resource Protection found corrupt files but was unable to fix some of them"

The solution is

from an elevated command prompt run

Dism /Online /Cleanup-Image /RestoreHealth

if successful then run

sfc /scannow 

again