Update current file - excel

Question

I'm creating code wherein Outlook will extract all emails to an existing Excel file.
The code works and extracts all emails from a selected folder. However, when I try to use the same code on a separate folder, let's say Sent Items, it doesn't extract the data and opens a Read only version of the Excel file.
I plan to leave Outlook and Excel Open.
How can I work with any Outlook folder and still update the Excel file?
Private Sub Application_NewMailv7()
Dim objNS As NameSpace
Dim objFolder As MAPIFolder
Dim currentExplorer As Explorer
Dim Selection As Selection
Dim obj As Object
Dim objOL As Outlook.Application
Dim objItems As Outlook.Items
Dim myItem As MailItem
Dim myXLApp As Excel.Application
Dim myXLWB As Excel.Workbook
Dim StrBody As String
Dim TotalRows As Long, i As Long
Set objOL = Outlook.Application
Set objFolder = objOL.ActiveExplorer.CurrentFolder
Set objItems = objFolder.Items
Set myXLApp = New Excel.Application
myXLApp.Visible = True
Set myXLWB = myXLApp.Workbooks.Open("C:\Users\username\Desktop\Folder Name\SR Historyv2.xlsx")
Set excWks = myXLWB.Worksheets("Sheet1")
TotalRows = Sheets(1).Range("A65536").End(xlUp).Row
i = TotalRows + 1
For Each obj In objItems
If obj.Class = olMail Then
'Add a row for each field in the message you want to export
excWks.Cells(i, 1) = Format(obj.ReceivedTime, "mm/dd/yyyy")
excWks.Cells(i, 2) = obj.SenderEmailAddress
excWks.Cells(i, 3) = obj.Subject
i = i + 1
'myXLWB.Save
End If
Next
Set obj = Nothing
Set objItems = Nothing
Set objFolder = Nothing
Set objOL = Nothing
End Sub

Answer 1

Try the following and if you would like to run Outlook Rule, let me know I will update the answer
Option Explicit
Sub Excel()
Dim xlApp As Object 'Excel App
Dim xlWB As Object 'WorkBook
Dim xlSheet As Object
Dim rngCount As Long
Dim xlStarted As Boolean
Dim xlPath As String
Dim olExplorer As Explorer
Dim olSelection As Selection
Dim olItem As Outlook.MailItem
Dim olMsg As Object
Dim xlColA, xlColB, xlColC, xlColD As String
'// Path of the Workbook - update only -> "\Folder Name\Folder Name\Book1.xlsx"
xlPath = Environ("USERPROFILE") & _
"\Documents\Temp\Book1.xlsx"
'// Set up Excel Application
On Error Resume Next
Set xlApp = GetObject(, "Excel.Application")
If Err <> 0 Then
Application.StatusBar = "Please wait while Excel source is opened ... "
Set xlApp = CreateObject("Excel.Application")
xlStarted = True
End If
On Error GoTo 0
'// Open the workbook to input the data
Set xlWB = xlApp.Workbooks.Open(xlPath)
Set xlSheet = xlWB.Sheets("Sheet1") ' or use (1) or (Sheet Name)
'// Record msg
On Error Resume Next
'// Find the next empty line of the worksheet
rngCount = xlSheet.Range("A" & xlSheet.Rows.Count).End(-4162).Row
'// Get the values from Outlook
Set olExplorer = Application.ActiveExplorer
'// Select Outlook msg
Set olSelection = olExplorer.Selection
For Each olMsg In olSelection
Set olItem = olMsg
'// Info to collect
xlColA = olItem.ReceivedTime
xlColB = olItem.SenderName
xlColC = olItem.SenderEmailAddress
xlColD = olItem.To
'// Write it to Excel sheet
xlSheet.Range("A" & rngCount) = xlColA
xlSheet.Range("B" & rngCount) = xlColB
xlSheet.Range("C" & rngCount) = xlColC
xlSheet.Range("D" & rngCount) = xlColD
'// Go to Next row
rngCount = rngCount + 1
Next
'// Save & Close Excel.Application
xlWB.Close 1
If xlStarted Then
xlApp.Quit
End If
'// Clean up
Set olItem = Nothing
Set olMsg = Nothing
Set olExplorer = Nothing
Set xlApp = Nothing
Set xlWB = Nothing
Set xlSheet = Nothing
End Sub

Answer 2

Do you close the SR Historyv2 workbook after you run the script or do you want to keep it open the entire time? If you keep it open and run the script again it will open the workbook a second time and that will be read only. For the second question i would suggest you look into the ItemAdd event in Outlook. This will only work if Outlook is open. https://msdn.microsoft.com/en-us/library/office/aa171270(v=office.11).aspx

Answer 3

I got this code working properly
Set myXLApp = GetObject(, "Excel.Application")
'specify the History File
With myXLApp
.Workbooks("SR Historyv2.xlsx").Activate
End With
It keeps the file to open and lets the other macro access it without being read-only.