设为首页收藏本站Access中国

Office中国论坛/Access中国论坛

 找回密码
 注册

QQ登录

只需一步,快速开始

12下一页
返回列表 发新帖
查看: 9534|回复: 12
打印 上一主题 下一主题

Outlook工具百宝箱

[复制链接]

点击这里给我发消息

跳转到指定楼层
1#
发表于 2006-3-7 09:26:00 | 只看该作者 回帖奖励 |倒序浏览 |阅读模式
Outook百宝箱:这是2001年帮公司做的一个作品,原来是繁体版本,现在重新改写成简体版本,并且支持了Access2003及Outlook2003 及以下版本.


软件下载: Outlook工具百宝箱本地下载



购买源码费用:2250元人民币


联系方式:[url=mailto:acnsoft@126.com]acnsoft@126.com[/url]   [url=mailto:tmtony@21cn.com]tmtony@21cn.com[/url]   13928102596  
技术支持:bbs.office-cn.net  www.office-cn.net








1.  完全Outlook对象的控制与功能加强(对几乎所有Outlook常用对象的编程控制)


2.  自动转寄


3.  对收件箱 发件箱 规则 选项 收发等功能控制


4.  自动排程,以实现自动转寄。


5.  排程可设置灵活的时间


6.  与Winfax传真功能结合


7.  与Exchange Server的公共联络人结合


8.  …………………………………………..





操作:


1.       程序启动时会自动启动Outlook


2.       启动后程序会隐藏在系统托盘中,双击任务栏中托盘图标(灯泡形状)即可打开Outlook百宝箱





界面:













































[upload=gif]UploadFile/20

本帖子中包含更多资源

您需要 登录 才可以下载或查看,没有帐号?注册

x
分享到:  QQ好友和群QQ好友和群 QQ空间QQ空间 腾讯微博腾讯微博 腾讯朋友腾讯朋友
收藏收藏 分享分享 分享淘帖 订阅订阅

点击这里给我发消息

2#
 楼主| 发表于 2006-3-7 09:52:00 | 只看该作者
部分代码示例:

Dim iPos As Integer
Dim nPrint As Integer
Dim nSend As Integer
Dim cAddress As String
Dim RetVal As Variant
On Error Resume Next

If Minute(Time()) Mod 10 = 0 Then  '下次时间对了
       Set myFolder = myNamespace.GetDefaultFolder(olFolderDeletedItems)
       While myFolder.items.Count > 0
         myFolder.items.Remove 1
        'Set myItem = myFolder1.items.GetFirst
        'If left(myItem.subject, 3) = cpFaxHead Then
        '    myItem.Delete
        'End If
       Wend
        FileSystem.Kill "c:\fax\*.*"
        
End If


Set myFolder = myNamespace.GetDefaultFolder(olFolderInbox)
Set myItems = myFolder.items
' Set myApptItem = myItems("测试")
nitemcount = myItems.Count

If nitemcount < npRecord + 1 Then
   nstartcount = 1
Else
   nstartcount = nitemcount - npRecord
End If

For j = nstartcount To nitemcount  '循环所有最新邮件
  Set myApptItem = myItems(j)
' DoEvents
    '  MsgBox myApptItem.sendername
    '  MsgBox myApptItem.replyRecipient.Name
    MsgBox myApptItem.userproperties.Count & myApptItem.subject
    MsgBox "5"
    MsgBox myApptItem.userproperties.Count
    MsgBox myApptItem.userproperties("处理状态") & "处理状态"
  If myApptItem.userproperties.Count = 0 Then '如果无自动处理标志

            Set myForward = myApptItem.Forward
'            Set myProp = myApptItem.userproperties.Add("自动处理标志", 6)
'            myProp.Value = True

            Set myProp = myApptItem.userproperties.Add("处理状态", 1)

            myProp.Value = ""
            myApptItem.Save
             MsgBox "9"
...................
...................
...................

            '判断是否传真
        If InStr(myApptItem.subject, cpFaxHead) = 0 Then '判断是否传真
                  '当邮件是 系统错误,邮件没发送出去, 或 跟踪对方有否看或邮件有否寄出去的邮件, 则会出错, 请改进.
...................
...................
...................


                    ' 检查发件人是否是香港的, 如不是,则不处理. 且无电脑的自动打印. 有winfax附件的另存后自动打印.
                    ' 保证一定是已处理的邮件才 将类别变为已转
                    nCount = myApptItem.Recipients.Count
                    '可改为 for each语句
                    For i = 1 To nCount                 '循环所有收件者
                      cAddress = myApptItem.Recipients(i).Name
                      MsgBox "收件者地址" & cAddress
                      If left(cAddress, 1) = "'" Then
                         cAddress = Mid(cAddress, 2)
                      End If
                      If right(cAddress, 1) = "'" Then
                         cAddress = left(cAddress, Len(cAddress) - 1)
                      End If
                      MsgBox "没替换之前地址" & cAddress
                        If left(cAddress, 1) = "Z" Then    '地址第一位为z
                                                           '判断是否为.....

                     '--------------2002年5月4日修改---tony---------------------
                            cAddress = Replace(cAddress, "\ ", "")       '替换掉里面的反斜杠
                            cAddress = Replace(cAddress, " (", "(")     '替换掉多余的空格 如...来的邮件
                            cAddress = Replace(cAddress, ") ", ")")     '替换掉英文括号全部为中文括号
                            cAddress = Replace(cAddress, "(电子邮件)", " (电子邮件)")
                     '-----------------------------------------------------
                           ...................
...................
...................

                  End If                       '是否无电脑人士
                            End If                          '判断是否为....
                        End If                              '地址第一位为z
                    Next                             '循环所有收件者
               '     myForwa
3#
发表于 2006-3-12 00:38:00 | 只看该作者
下载试用。谢谢!
4#
发表于 2006-5-1 06:01:00 | 只看该作者
好,支持
5#
发表于 2008-1-28 16:59:24 | 只看该作者
不是一般的好,而是非常好.
6#
发表于 2009-2-2 15:02:39 | 只看该作者
不是一般的好,而是非常好.
7#
发表于 2009-3-22 10:52:20 | 只看该作者
是一个集成工具吗?
8#
发表于 2009-4-20 19:23:28 | 只看该作者
Thanks a lot.
9#
发表于 2009-5-14 13:55:56 | 只看该作者
好啊
10#
发表于 2009-12-22 23:32:18 | 只看该作者
谢谢
您需要登录后才可以回帖 登录 | 注册

本版积分规则

QQ|站长邮箱|小黑屋|手机版|Office中国/Access中国 ( 粤ICP备10043721号-1 )  

GMT+8, 2024-11-15 16:01 , Processed in 0.078288 second(s), 34 queries .

Powered by Discuz! X3.3

© 2001-2017 Comsenz Inc.

快速回复 返回顶部 返回列表