Forum Discussion
Outlook export multiple emails in Excel workbook but different excel worksheets
HI beautiful people, if anyone facing same problem, you can try this solution i got from an expert.
I made an update to this macro, tell me yes or no if its helpful
as macro do loop in For x it open the file x times,
and then close it and open again instead of working on the first workbook opened
but the macro leaves open instances
here is the current code
Public Sub SplitEmail()
Dim rpl As Outlook.MailItem
Dim itm As Object
Dim sPath As String, sFile As String
Dim objDoc As Word.Document
Dim txt As String
Dim xlApp As Excel.Application
Dim wb As Excel.Workbook
Dim i As Long
Dim x As Long
'----------------------------
Dim myOlExp As Outlook.Explorer
Dim myOlSel As Outlook.Selection
Set myOlExp = Application.ActiveExplorer
Set myOlSel = myOlExp.Selection
For x = 1 To myOlSel.Count
'----------------------------------------------
Dim objApp As Outlook.Application
Dim GetCurrentItem As Object
Set objApp = Application
On Error Resume Next
Select Case TypeName(objApp.ActiveWindow)
Case "Explorer"
Set GetCurrentItem = objApp.ActiveExplorer.Selection.item(x)
Case "Inspector"
Set GetCurrentItem = objApp.ActiveInspector.CurrentItem
End Select
GetCurrentItem.UnRead = False
Set objApp = Nothing
'-----------------------------------------------
Set itm = GetCurrentItem
sPath = "C:\Users\Ray\"
sFile = sPath & "Macro.xlsm"
If Not itm Is Nothing Then
'de lo contrario, se crea un Reply del correo en formato HTML
Set rpl = itm.Reply
rpl.BodyFormat = olFormatHTML
'rpl.Display
End If
Set objDoc = rpl.GetInspector.WordEditor
txt = objDoc.Content.Text
'||||||||||||||||||||||||||||||||||||||||||||||
Set xlApp = CreateObject("Excel.application")
xlApp.Visible = True
Set wb = xlApp.Workbooks.Open(sFile)
xlApp.Windows("Macro.xlsm").Activate
'Set wb = ActiveWorkbook
'||||||||||||||||||||||||||||||||||||||||||||||
For i = LBound(Split(txt, Chr(13)), 1) To UBound(Split(txt, Chr(13)), 1)
wb.Worksheets(x).Range("A" & i + 1).Value = Split(txt, Chr(13))(i)
Next i
xlApp.Windows("Macro.xlsm").Close SaveChanges:=True
xlApp.Workbook.Close SaveChanges:=False
'------------------------------------------------------
Next x
'------------------------------------------------------
'the instances should closed but not working, instances are empty
For Each wb In xlApp
wb.Close SaveChanges:=False
Next
End Sub