在Outlook中,我有一个VBA脚本,它可以读取新的传入电子邮件并将一些信息保存到Excel文件中,还可以将文本正文和任何附件保存到文件夹中.现在,我想更改我的脚本,以便保存任何类别为"Blue"的电子邮件.
所以我修改了这里的一些部分,如下所示:
Public WithEvents objMails As Outlook.Items
Private Sub Application_Startup()
Set objMails = Outlook.Application.Session.GetDefaultFolder(olFolderInbox).Items
End Sub
Private Sub objMails_ItemChange(ByVal Item As Object)
If Item.Class = olMail And Item.Categories = "Blue" Then
Set objMail = Item
Else
Exit Sub
End If
....
Run Code Online (Sandbox Code Playgroud)
其余代码包含有关保存的详细信息,其中没有一个从我之前的工作脚本中更改过,但为了完整起见,我已将其包含在此处.
...
'Specify the Excel file which you want to auto export the email list
'You can change it as per your case
strRootFolder = "N:\Outlook Excel VBA\"
strExcelFile = "EmailBookTest3.xlsx"
'Get Access to the Excel file …Run Code Online (Sandbox Code Playgroud) 我的VBA技能非常有限但我到目前为止我现在想完成这个项目.
我的VBA代码低于我的前景.它将所需的电子邮件保存到我的驱
Private WithEvents Items As Outlook.Items
Private Sub Application_Startup()
Dim olApp As Outlook.Application
Dim objNS As Outlook.NameSpace
Set olApp = Outlook.Application
Set objNS = olApp.GetNamespace("MAPI")
Set Items = objNS.GetDefaultFolder(olFolderInbox).Items
End Sub
Private Sub Items_ItemAdd(ByVal item As Object)
On Error GoTo ErrorHandler
'Only act if it's a MailItem
Dim Msg As Outlook.MailItem
If TypeName(item) = "MailItem" Then
Set Msg = item
'Change variables to match need. Comment or delete any part unnecessary.
If (Msg.SenderEmailAddress = "noreply@test.com") Or _
(Msg.Subject = …Run Code Online (Sandbox Code Playgroud) 我正在寻找一种方法来永久删除带有VBA代码的Outlook 2000中的MailMessage.我想这样做,而不必做第二个循环来清空已删除的项目.
本质上,我正在寻找一个等同于点击消息和点击SHIFT+ 的UI方法的代码DELETE.
有这样的事吗?
Dim olApp As Outlook.Application
Dim objNS As Outlook.NameSpace
Set olApp = Outlook.Application
Set objNS = olApp.GetNamespace("MAPI")
Set myOlItems = objNS.GetDefaultFolder(olFolderInbox).Items
Run Code Online (Sandbox Code Playgroud)
我使用上面的代码访问主要的Outlook收件箱,但如何使用vba访问收件箱中的文件夹和邮件!
我正在尝试在Outlook中创建一个编号列表,并根据顶级列表项操作它.不幸的是,我发现操作列表的唯一方法是通过ListParagraph类型,它可以平等地分解所有列表项(包括子项),而不是对列表中的每个级别具有不同的访问权限.
有没有办法在一个对象中访问列表项及其所有子项?
谢谢.
这是我目前使用的,适用于只有一个级别项目的列表:
While i <= oMeetingWordDoc.Lists(1).ListParagraphs.Count
Set oRange = oMeetingWordDoc.Lists(1).ListParagraphs(i).Range
*Perform actions with oRange
i = i + 1
wend
Run Code Online (Sandbox Code Playgroud)
通过"一级"列表,我的意思是这样的:
通过带有"子项"的列表,我的意思是这样的:
清单项目1
a)项目a
b)项目b
c)项目c
第2项
a)项目a
b)项目b
第3项
a)项目a
我将编写一个VBA代码,该代码将根据某些条件从Outlook中检索电子邮件.我的问题是我必须在我的代码中表示某个文件夹(在下面的示例中,表示的文件夹是"PRE Costumer".我想从我的"收件箱"中查找所有电子邮件,或者更好地从所有outlook文件夹中查找问题是我的收件箱包含许多子文件夹(因为规则0.我的问题是我可能不知道所有的子文件夹名称(因为许多用户将使用宏,甚至有人可以在个人文件夹中有电子邮件) .
能否请您指教,有没有办法解决这个问题吗?
请让我知道,如果这个问题是模糊的(因为我是新人)
请找到我有问题的标有评论的行.
Sub GetFromInbox()
Dim olApp As Outlook.Application
Dim olNs As Namespace
Dim Fldr As MAPIFolder
Dim olMail As Variant
Dim i As Integer
Set olApp = New Outlook.Application
Set olNs = olApp.GetNamespace("MAPI")
'Below is the line I have problem with
Set Fldr = olNs.GetDefaultFolder(olFolderInbox).Folders("PRE Customer")
i = 1
x = Date
For Each olMail In Fldr.Items
If InStr(olMail.Subject, "transactions") > 0 _
And InStr(olMail.ReceivedTime, x) > 0 Then
ActiveSheet.Cells(i, 1).Value = olMail.Subject
ActiveSheet.Cells(i, 2).Value = …Run Code Online (Sandbox Code Playgroud) 我正在尝试使用VBA从指定目录打开.msg文件,但我不断收到运行时错误.
我有的代码:
Sub bla()
Dim objOL As Object
Dim Msg As Object
Set objOL = CreateObject("Outlook.Application")
inPath = "C:\Users\SiliconPlus\Desktop\Si+ Contact Lists\Contact_Si+"
thisFile = Dir(inPath & "\*.msg")
Set Msg = objOL.CreateItemFromTemplate(thisFile)
' now use msg to get at the email parts
MsgBox Msg.Subject
Set objOL = Nothing
Set Msg = Nothing
End Sub
Run Code Online (Sandbox Code Playgroud)
这是运行时错误:
运行时错误'-2147287038(80030002)':
无法打开文件:AUTO Andy Low Yong Cheng不在办公室(2014年9月22日返回).msg.
该文件可能不存在,您可能没有权限打开它,或者它可能在另一个程序中打开.右键单击包含该文件的文件夹,然后单击"属性"以检查该文件夹的权限.
我第一次运行它时,下面的代码运行正常,但是当我需要第二次运行它时,它给了我这个错误:
运行时错误'462':远程服务器计算机不存在或不可用
它不会一直发生,所以我认为它与Word(不)在后台运行有关...?我在这里错过了什么?
Sub Docs()
Sheets("examplesheet").Select
Dim WordApp1 As Object
Dim WordDoc1 As Object
Set WordApp1 = CreateObject("Word.Application")
WordApp1.Visible = True
WordApp1.Activate
Set WordDoc1 = WordApp1.Documents.Add
Range("A1:C33").Copy
WordApp1.Selection.PasteSpecial Link:=False, DataType:=wdPasteRTF, _
Placement:=wdInLine, DisplayAsIcon:=False
Application.Wait (Now + TimeValue("0:00:02"))
WordDoc1.PageSetup.TopMargin = CentimetersToPoints(1.4)
WordDoc1.PageSetup.LeftMargin = CentimetersToPoints(1.5)
WordDoc1.PageSetup.BottomMargin = CentimetersToPoints(1.5)
' Control if folder exists, if not create folder
If Len(Dir("F:\documents\" & Year(Date), vbDirectory)) = 0 Then
MkDir "F:\documents\" & Year(Date)
End If
WordDoc1.SaveAs "F:\documents\" & Year(Date) & "\examplename " & …Run Code Online (Sandbox Code Playgroud) 刚刚学习R Markdown语言并想知道我是否可以通过Outlook的Outlook发送身体电子邮件中的输出(使用RDCOMClient;我的办公室不使用gmail)
谢谢
我是Outlook VBA(Office 365版)的新手,我想要实现的是循环浏览文件夹中的所有电子邮件("收件箱"中的"abc@outlook.com")并移动主题与特定主题相匹配的电子邮件RegEx到另一个文件夹.
由于这是我第一次使用Outlook VBA,并且不熟悉其对象模型,因此我一直在努力拼凑出一个解决方案.
这是我到目前为止(我通过编写组件步骤的简单示例,然后构建最终的复合函数)来学习:
Sub RegExpMoveEmailToFolderSO()
Dim MyFolder As Outlook.Folder
Dim MyNS As NameSpace
Dim MyEmail As Outlook.MailItem
Dim MyItems As Outlook.Items
Dim CountMatches As Integer
Dim MySubject As String
Dim MyRegExp As RegExp
Dim MyDestinationFolder As Outlook.Folder
Set MyNS = Application.GetNamespace("MAPI")
Set MyFolder = MyNS.Folders("xyz@abc.com").Folders("Inbox")
Set MyDestinationFolder = MyNS.Folders("uvw@def.com").Folders("Inbox")
Set MyItems = MyFolder.Items
Set MyRegExp = New RegExp
CountMatches = 1
MyRegExp.Pattern = "(Reg).*(Exp)"
For Each Item In MyItems
MySubject = Item.Subject
If MyRegExp.Test(MySubject) Then
Item.Move MyDestinationFolder …Run Code Online (Sandbox Code Playgroud) outlook-vba ×10
vba ×9
outlook ×7
excel ×4
excel-vba ×2
word-vba ×2
message ×1
r ×1
r-markdown ×1
rdcomclient ×1
regex ×1
subdirectory ×1