Outlook не передает ни одному из моих пользователей свои свойства через MailItem.PropertyAccessor.
Это полностью обходит мой код.
Я протестировал всех 15 пользователей, которые у меня есть. Только у одного есть эта проблема. После строки MyMail.display True, пока я нахожусь в электронном письме, он проходит мимо кода, который читает Set propertyAccessor = MyMail.PropertyAccessor.
Я не могу понять, почему это происходит.
On Error GoTo Mailerror
If btn_Complete.Caption = "Mark Pending" Then
Dim rs_Uncomplete As ADODB.Recordset
Dim rs_ProdUncomplete As ADODB.Recordset
Dim rs_CompleteCheck As ADODB.Recordset
Dim strSqlEpif As String
Dim myItem As Object
Dim MyNamespace As Outlook.Namespace
Dim MyFolder As Outlook.Folder
Dim MyMail As MailItem
Dim strSqlProd As String
Dim StrProdid As String
Dim LastVerbExecuted As Long
Dim StrRepliedTime As String
Dim propertyAccessor As Outlook.propertyAccessor
Dim olSharename As Outlook.Recipient
Dim RepliedTime As Date
'On Error GoTo err_Complete
If OpenAppConnection Then
'strSqlEpif = "SELECT [Recordid],[CompleteDate] ,[Complete] ,
[InProgress] ,[ProdID] ,[UnComplete_Date] ,[UnCompletedby],opened " & _
' " From [dbo].[Epif_inventory] " & _
' " where recordid like '" & Recordid & "'"
'
strSqlEpif = "SELECT * " & _
" From [dbo].[Epif_Inventory_testing] " & _
" where recordid like '" & Recordid & "'"
Set rs_Uncomplete = New ADODB.Recordset
With rs_Uncomplete
Set .ActiveConnection = GCNN
.Source = strSqlEpif
.LockType = adLockOptimistic
.CursorType = adUseClient
.Open
StrProdid = "" 'Nz(.Fields("Prodid"), "")
' .Update
.Fields("CompleteDate") = Null
.Fields("Uncomplete_date") = Now
.Fields("Complete") = False
.Fields("Inprogress") = True
.Fields("unCompletedby") = UserID
.Fields("prodid") = Null
.Update
End With
'Per dena disconnect. leave production completion available
End If
' now update the completion to
ElseIf Left(btn_Complete.Caption, 4) = "View" Then
'only open if below if a normal completion
'need to test of prodid having a value
Set rs_CompleteCheck = New ADODB.Recordset
If OpenAppConnection Then
'strSqlEpif = "SELECT [Recordid],[CompleteDate] ,[Complete] ,
[InProgress] ,[ProdID] ,[UnComplete_Date] ,[UnCompletedby] " & _
' " From [dbo].[Epif_Inventory_testing] " & _
' " where recordid like '" & Recordid & "'"
strSqlEpif = "SELECT ei.*" & _
" ,pe.Exclude_EMail " & _
" , pa.APP_name " & _
" FROM [dbo].[Epif_Inventory_testing] ei " & _
" left join dbo.PDM_Errors pe on ei.[From]=pe.Exclude_EMail " & _
" left join dbo.PDM_Applications pa on pa.App_ID=pe.AppID where
ei.recordid = '" & Me.Recordid & "'"
' strSqlEpif = "SELECT * " & _
' " From [dbo].[Epif_Inventory_testing] " & _
' " where recordid like '" & Recordid & "'"
Set rs_CompleteCheck = New ADODB.Recordset
With rs_CompleteCheck
Set .ActiveConnection = GCNN
.Source = strSqlEpif
.LockType = adLockOptimistic
.CursorType = adUseClient
.Open
End With
Dim CompleteExclude As String
CompleteExclude = ""
CompleteExclude =
Nz(rs_CompleteCheck.Fields("Exclude_Email").Value,
"")
If completexclude = "" Then
If rs_CompleteCheck.Fields("Opened") = False Then
Set outlookApp = CreateObject("Outlook.application")
'Set outlookapp = CreateObject("Outlook.application")
Dim folderpath As String
folderpath = "Dennis"
' MsgBox "You havent replied to email assignment",
vbOKOnly, "Email Error"
Set MyNamespace = outlookApp.GetNamespace("MAPI")
Set olSharename =
MyNamespace.CreateRecipient("PDM_Epif@hnfs.com")
'Set MyFolder =
MyNamespace.GetSharedDefaultFolder(olSharename, olFolderInbox)
Set MyFolder =
MyNamespace.GetSharedDefaultFolder(olSharename, olFolderInbox)
Dim mySubFolder As Outlook.Folder
Set mySubFolder = MyFolder.Parent.Folders("Dennis") 'take
this out later
'folderpath=
'Set MyFolder = MyNamespace.GetDefaultFolder()
Set MyMail =
MyNamespace.GetItemFromID(rs_CompleteCheck.Fields("Entryid").Value,
rs_CompleteCheck.Fields("Storeid").Value)
'On Error Resume Next
MyMail.display True
'===================================================================
Set propertyAccessor = MyMail.propertyAccessor
LastVerbExecuted = CheckBlankFields("PR_LAST_VERB_EXECUTED",
propertyAccessor.GetProperty("http://schemas.microsoft.com/mapi/proptag/0x10810003"))
Select Case LastVerbExecuted
Case Last_Verb_Reply_All, Last_Verb_Reply_Sender,
Last_Verb_Reply_Forward
'MsgBox "it means email already responded"
'Exit Sub
'i dont think there is need to check time
StrRepliedTime =
CheckBlankFields("PR_LAST_VERB_EXECUTION_TIME",
propertyAccessor.GetProperty("http://schemas.microsoft.com/mapi/proptag/0x10820040"))
If StrRepliedTime <> "" Then
RepliedTime = CDate(StrRepliedTime)
rs_CompleteCheck.Fields("Opened") = 1
rs_CompleteCheck.Fields("ReplyedDate") =
GetLocalTimeFromGMT(RepliedTime)
End If
Case Else
' MsgBox "You didnt reply"
Dim response As Integer
'in case you want to do something here
response = MsgBox("You didn't reply to the mail" &
vbCrLf & "would you like to place this in pending?", vbYesNo,
"Email
Reply")
If response = vbNo Then
GoTo exitComplete
Else
rs_CompleteCheck.Fields("Opened") = False
rs_CompleteCheck.Fields("Inprogress").Value = True
rs_CompleteCheck.Update
GoTo exitComplete
End If
End Select
rs_CompleteCheck.Update
' GoTo exitComplete
Else
' Dim response
End If
End If
'Stop
'== need to pass entryid and storeid to form
If Not IsNull(rs_CompleteCheck.Fields("ProdID").Value) Then
DoCmd.OpenForm "PDM_Completion", acNormal, , , acFormEdit,
acDialog, "5|" & Recordid & "|" & rs_CompleteCheck.Fields("ProdID")
Else
DoCmd.OpenForm "PDM_Completion", acNormal, , , acFormEdit,
acDialog, "5|" & Recordid '& "|" & rs_CompleteCheck.Fields("Storeid") &
"|" & rs_CompleteCheck("Entryid")
End If
End If ' open connection
End If 'if pending
': err_Complete
'If Err.Number = "-2177417851" Then
'Resume Next
'Else
'MsgBox "Error " & Err.Number & " " & Err.Description
'End If
exitComplete:
If olSave <> 0 Then
MyMail.Close (olSave)
End If
Me.RecordSource = ""
Call Form_frm_EPIF_inventoryNew.UPDateMain
ExitButton_Click
Set rs_CompleteCheck = Nothing
Set rs_Uncomplete = Nothing
Set rs_ProdUncomplete = Nothing
Exit Sub
Mailerror:
Select Case Err.Number
Case 0
Resume Next
Case "-2147221233"
MsgBox "Mail has either been moved or deleted", vbOKOnly,
"Outlook error"
Case 91
GoTo exitComplete
Case Else
End Select
End Sub