求OUTLOOK发送的宏

[ice2water]

在OUTLOOK的发件箱中有大量邮件，需要每隔一段时间用鼠标点一下“发送”，求这样的宏：
1、发送
2、间隔一段时间，如2分钟
3、发送
4、循环直到发件箱中邮件为空。
谢谢

[ice2water]

没人知道吗？

[蒋晟]

outlook不是有定时收发邮件的选项么？

[ice2water]

在发送时一次只能发送20个邮件，需要不断的重复发送。

[ice2water]

我编了一个宏，可以逐条发送，只是需要一个延时2分钟的函数
Sub ss()
Dim myOlApp As Outlook.Application
Dim objNameSpace As Outlook.NameSpace
Dim objMAPIFolder As Outlook.MAPIFolder
Dim objMailItem As Outlook.MailItem
Dim myitem As Outlook.AppointmentItem
Dim lngMailCounter As Long
Dim datemail As Date

Set myOlApp = CreateObject("Outlook.Application")
Set objNameSpace = myOlApp.GetNamespace(Type:="MAPI")
Set objMAPIFolder = _
objNameSpace.GetDefaultFolder(FolderType:=olFolderOutbox)
lngMailCounter = 1
datemail = objMailItem.SentOn
For Each objMailItem In objMAPIFolder.Items
objMailItem.Send
lngMailCounter = lngMailCounter + 1
If lngMailCounter > 20 Then
延时2分钟
lngMailCounter = 1
End If
Next objMailItem
End Sub

请大虾帮忙

[ice2water]

请问如何判断发件箱是否空？

[蒋晟]

用Outlook录制一下宏，之后在程序里面调用看看

[ice2water]

Private Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
Public lngend As Long

Sub ss()
lngend = 0
Do While lngend = 0
star
Sleep 120000
Loop
End Sub


Sub star()
Dim myOlApp As Outlook.Application
Dim objNameSpace As Outlook.NameSpace
Dim objMAPIFolder As Outlook.MAPIFolder
Dim objMailItem As Outlook.MailItem
Dim lngMailCounter As Long
Dim myitem As Outlook.AppointmentItem

Dim datemail As Date

Set myOlApp = CreateObject("Outlook.Application")
Set objNameSpace = myOlApp.GetNamespace(Type:="MAPI")
Set objMAPIFolder = _
objNameSpace.GetDefaultFolder(FolderType:=olFolderOutbox)
lngMailCounter = 1

For Each objMailItem In objMAPIFolder.Items
objMailItem.Send
lngMailCounter = lngMailCounter + 1
If lngMailCounter > 20 Then
lngMailCounter = 1
End If
Next objMailItem
If objMAPIFolder Is Nothing Then
lngend = 1
End If
End Sub

供大家参考

[sunyi000]

应该可以用 if objMAPIFolder.Items.Count then.......，每发一次循环循环到这，来判断发件箱是否有邮件