|
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 |
|