问题描述
我是使用 vba 的新手,我想从选择的 Outlook 电子邮件导出到工作簿路径,并且每封电子邮件(主题、正文等)都应存储在不同的工作表中,我正在尝试编辑此宏,因为它几乎是我需要的,特别是 olFormatHTML
和 WordEditor
的部分,因为 split
这个想法是
1.-在Outlook中选择多封电子邮件
2.-打开文件路径
3.-对于在 Outlook 中选择的每封电子邮件将存储在打开的文件中的单个工作表中
我在第三部分遇到宏问题
A).- 从选定的项目中,宏会循环并选择第一封电子邮件
B).- 电子邮件存储在不同的工作簿中,应该存储在我打开的同一个工作簿中
这是代码
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,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
这个问题是B:上面的代码,当宏do循环“x”增加时,不同工作表但不同工作簿中的电子邮件存储应该在同一个工作簿中
解决方法
我更新了这个宏
作为 For x
中的宏循环,它打开文件 x 次,
然后关闭它并再次打开,而不是在打开的第一个工作簿上工作
但宏留下了打开的实例
这是当前代码
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,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
,
完成,我在保存文件后添加了 xlApp.Quit
并删除了最后一部分 For Each wb In xlApp...