I'm new using vba, I want to export from outlook emails selected into a workbook path, and each email (subject, body,etc.) should be store in different worksheet and I'm trying to edit this macro because its almost what I need, especialy the part of olFormatHTML and WordEditor, because of split
The idea is
1.-select multiple emails in Outlook
2.-open file path
3.-for each email selected in Outlook will be stored in a single worksheet from file opened
I'm getting issue with the macro in this 3rth part
A).- from selected items the macro do loop and just take the first email selected
B).- the emails store in different workbooks, should be stored in the same workbook that I opened
here is the 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
'----------------------------------------------
Set itm = GetCurrentItem() 'A)I think the issuefrom selecting 1 item is located here
'|||||||||||||||||||||||||||||||||||||||||
sPath = "C:\Users\Ray\"
sFile = sPath & "Macro.xlsm"
If Not itm Is Nothing Then
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) 'B) tried to move it to the beginning and macro doesn't work
'||||||||||||||||||||||||||||||||||||||||||||||
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) 'B)emails in diferrent sheet but no same workbook
Next i
'------------------------------------------------------
Next x
End Sub
Function GetCurrentItem() As Object
Dim objApp As Outlook.Application
Set objApp = Application
On Error Resume Next
Select Case TypeName(objApp.ActiveWindow)
Case "Explorer"
Set GetCurrentItem = objApp.ActiveExplorer.Selection.item(1)
Case "Inspector"
Set GetCurrentItem = objApp.ActiveInspector.CurrentItem
End Select
GetCurrentItem.UnRead = False
Set objApp = Nothing
End Function
this issue is B: The code above, when macro do loop "x" increase, the email store in different sheets but in different workbooks, should be in the same workbook
