none
Outlook 2013 VBA Statement ..GetDefaultFolder(olFolderDeletedItems) return RunTime Error RRS feed

  • Question

  • The statement work perfectly in previous version of Outlook.

    Can someone help me?

    Thanks Marzio

    Tuesday, November 11, 2014 11:07 AM

All replies

  • Hello Marzio,

    What runtime error do you get in the code? Could you please be more specific?

    What code do you use?

    Did you try to use the GetDefaultFolder method of the Store class instead? Do you get the same results in that case?

    • Marked as answer by Marzio48 Tuesday, November 11, 2014 2:50 PM
    • Unmarked as answer by Marzio48 Tuesday, November 11, 2014 2:50 PM
    Tuesday, November 11, 2014 12:19 PM
  • Hello,

    I have the following code in a VB6 DLL that works perfectly with versions earlier than Outlook2013, but Outlook2013 return the error Run-time error '-2147467259 (80004005)':

    ........

    Dim MyItem As Outlook.MailItem Dim WorkItem As Outlook.MailItem Dim DeletedItemsFolder As Outlook.MAPIFolder Dim TempFolder As Outlook.MAPIFolder Dim myAttachment As Outlook.Attachment Dim TempFile$, TempPath$ Dim OldPointer Dim retLen As Long Dim i As Long '-- set hourglass OldPointer = Screen.MousePointer Screen.MousePointer = vbHourglass '-- get ExportFile Name (use windows temporary directory) TempPath$ = String$(255, 0) retLen = GetTempPath(Len(TempPath$), TempPath$) TempPath$ = Left$(TempPath$, retLen) '-- add trailing backspace If Right$(TempPath$, 1) <> "\" Then TempPath$ = TempPath$ & "\" End If TempFile$ = TempPath$ & "mfol2000.msg" '|1| '-- get current item Set MyItem = oApp.ActiveInspector.CurrentItem '-- make copy of item Set WorkItem = MyItem.Copy '-- create temporary folder and move copy to it Set DeletedItemsFolder = oNS.GetDefaultFolder(olFolderDeletedItems) '-- delete the temporary folder For i = 1 To DeletedItemsFolder.Folders.count If DeletedItemsFolder.Folders(i).Name = GT$("Staffware Temporary Folder", 71, 10) Then DeletedItemsFolder.Folders(i).Delete Exit For End If Next i Set TempFolder = DeletedItemsFolder.Folders.Add(GT$("Staffware Temporary Folder", 71, 10)) Set WorkItem = WorkItem.Move(TempFolder)

    .....

    Thanks Marzio

    • Edited by Marzio48 Tuesday, November 11, 2014 2:28 PM
    Tuesday, November 11, 2014 2:23 PM
  • I don't see any Session property in the code. Moreover, it doesn't clear where the oNS object come from.
    Tuesday, November 11, 2014 2:42 PM
  • Hello Eugene,

    This is the complete Module

    DefLng A-Z
    Option Explicit
    
    Public oCDO As Object
    Public oApp As Outlook.Application
    Public oNS As Outlook.NameSpace
    '-- find Staffware record
    
    
    Public Declare Function GetTempPath Lib "kernel32" Alias "GetTempPathA" (ByVal nBufferLength As Long, ByVal lpBuffer As String) As Long
    Public Declare Function GetTickCount Lib "kernel32" () As Long
    'Public Const SW_NORMAL = 1
    Public Const SWP_NOSIZE = &H1
    Public Const SWP_SHOWWINDOW = &H40
    Public Const SWP_NOMOVE = &H2
    'Public Const SWP_NOACTIVATE = &H10
    
    Public Type CONTACTSTRUCT
       ClientSysRecordID As String
       ClientName As String
       ContactSysREcordID As String
       ContactName As String
       ContactEmail As String
       ParentTable As String
       SysRoute As String
       DisplayNameMatch As Boolean         ' true for displayname / false for domain name
    End Type
    
    Public rContacts() As CONTACTSTRUCT
    Dim rContactsCount As Integer
        
          
    ''Public Const LB_SETTABSTOPS = &H192
    '#If USEMKTFORCEREF = 0 Then
    '
    '   Global Const DDM_UCASE = &H1      'Only allows upper case
    '   Global Const DDM_LCASE = &H2      'Only allows lower case
    '   Global Const DDM_UKEY = &H4       'Unique key.  Must be unique value.
    '   Global Const DDM_NULL = &H8       'Nullable.  This column can be nulled (unknown value)?
    '   Global Const DDM_BLANK = &H10     'Allows blank values
    '   Global Const DDM_NOEDIT = &H20    'Don't allow a column to be edited
    '   Global Const DDM_ONLYEMPTY = &H40 'Allow editing only if empty
    '   Global Const DDM_ONLYADD = &H80   'Allow editing only on an add
    '   Global Const DDM_ONLYDS = &H100   'Allow editing only by data selection
    '
    '
    '   Public Enum swol2000sweColTypeConstants
    '      sweSysRecordID = 1
    '      sweSysRouting = 2
    '      sweSysParentID = 3
    '      sweDefaultDisplay = 4
    '      sweAddDate = 5
    '      sweUpdateDate = 6
    '      sweSysParentTable = 7
    '   End Enum
    '
    '   Public Enum sweColumnConstraintConstants
    '      sweUpperCase = DDM_UCASE
    '      sweLowerCase = DDM_LCASE
    '      sweMustBeUnique = DDM_UKEY
    '      sweAllowNullValue = DDM_NULL
    '      sweAllowBlankValue = DDM_BLANK
    '      sweNoEdit = DDM_NOEDIT
    '      sweEditOnlyIfEmpty = DDM_ONLYEMPTY
    '      sweEditOnlyOnAdd = DDM_ONLYADD
    '      sweEditOnlyWithDataSelection = DDM_ONLYDS
    '   End Enum
    '
    '   Public oMF As Object
    '   Public ds As Object 'mfDataSet
    '
    '#Else
       Public oMF As StaffwareCRM.sweApplication
       Public ds As StaffwareCRM.sweDataSet
    '#End If
    'Public oMF As MktForce.Application
       Public Command$
       Public gCommandLine$, gUserEmailAddress$
       Public gAutoSearch As Integer
       Public gSkipFinalPage As Boolean
       Public gSkipIntroductionPage As Boolean
       Public gSkipFieldSearchPage As Boolean
       Public gSearchEMail As Boolean
       Public gSearchCompany As Boolean
       Public gSearchTelephone As Boolean
    Sub Configure()
       '-- load configuration form
       Call LoadSettings
       
       frmConfig.tbxCommandLine.Text = gCommandLine$
       frmConfig.tbxEmailAddress.Text = gUserEmailAddress$
       frmConfig.chkAutoSearch.Value = Abs(gAutoSearch)
       frmConfig.chkSkipIntroductionPage.Value = Abs(gSkipIntroductionPage)
       frmConfig.chkSkipFieldSearchPage.Value = Abs(gSkipFieldSearchPage)
       frmConfig.chkSkipLastPage.Value = Abs(gSkipFinalPage)
       frmConfig.chkSearchEMail = Abs(gSearchEMail)
       frmConfig.chkSearchCompany = Abs(gSearchCompany)
       frmConfig.chkSearchTelephone = Abs(gSearchTelephone)
       
       '-- load the form
       Load frmConfig
       
       '-- show form
       '-- Switched to showmodal because that works much better in the environment
       'than the .show method.
       Call ShowModal(frmConfig)
       'frmConfig.Show 1
       
    End Sub
    Public Function FindContact(ByVal EMailAddress$, errmsg As String) As Boolean
       '-- dim variables
       Dim i As Long
       Dim OldPointer
       Dim MyItem As MailItem
       Dim WorkItem As MailItem
       
       Dim sContacts$, sEmailField$
       
       Dim ParentRecID$
    '   #If USEMKTFORCEREF = 0 Then
    '   Dim TableDEF As Object
    '   Dim ds As Object
    '   Dim CDS As Object
    '   Dim ColDef As Object
    '   #Else
       Dim TableDEF As StaffwareCRM.sweTableDef
       Dim ds As StaffwareCRM.sweDataSet
       Dim CDS As StaffwareCRM.sweDataSet
       Dim ColDef As StaffwareCRM.sweColDef
    '   #End If
       Dim SysParentCol$
       Dim SysRecordCol$
       Dim ParentTable$
       Dim ParentTableCol$
       Dim ParentDisplayCol$
       Dim ParentTableAlias$
       Dim ClientName$
       
       
       
       Dim myAttachment As Outlook.Attachment
       Dim TmpAttachment As Outlook.Attachment
       Dim retLen As Long
       Dim cnt
       Dim TempRecID As Long
       Dim CheckRecipient As Boolean
       
       Dim TempFolder As MAPIFolder
       Dim DeletedItemsFolder As MAPIFolder
       Dim x, DomainName$
       Dim DomainSearch As Boolean
       
                
       '-- get contact field information
       '-- Converting to using new COM object model methods.
       'sContacts$ = oMF.AppCode(oMF.ConfigIndex("MarketForce", 1), 256)
       sContacts$ = oMF.Code(256)
       
       
       
       '-- make sure the contacts table is set
       If Len(sContacts$) = 0 Then
          Screen.MousePointer = vbNormal
          frmAttach.picSearch.Visible = False
          MsgBox GT$("Staffware App.Config.256 (Contacts Table) must be set in order to attach items !", 44, 10), vbExclamation, GT$("Staffware Outlook Add-In", 45, 10)
          errmsg$ = GT$("(Invalid Configuration)", 84, 10)
          GoTo done
       Else
          '-- check for contacts table (get sysparentID field name)
          On Error Resume Next
          '-- Converting to new COM property
          'Set TableDEF = oMF.Tables(sContacts$)
          Set TableDEF = oMF.TableDefs(sContacts$)
          On Error GoTo 0
          
          '-- make sure table specifed is valie
          If TableDEF Is Nothing Then
             Screen.MousePointer = vbNormal
             frmAttach.picSearch.Visible = False
             MsgBox GT$("Unable to locate table [", 47, 10) & sContacts$ & GT$("] specified in Staffware App.Config.256 !", 78, 10), vbExclamation, GT$("Staffware Outlook Add-In", 45, 10)
             errmsg$ = GT$("(Invalid Configuration)", 84, 10)
             GoTo done
          Else
             '-- get columns
             '-- Converting to using latest COM object model.
             'SysParentCol$ = TableDEF.SystemColumn(TableDEF.TableId, 3, True)
             'SysParentCol$ = TableDEF.SystemColumnName(TableDEF.TableId, sweSysParentID)
             SysParentCol$ = TableDEF.SystemColumnName(sweSysParentID)
             'ParentTableCol$ = TableDEF.SystemColumn(TableDEF.TableId, 7, True)
             'ParentTableCol$ = TableDEF.SystemColumnName(TableDEF.TableId, sweSysParentTable)
             ParentTableCol$ = TableDEF.SystemColumnName(sweSysParentTable)
             
             '-- get column configured as e-mail field
             '-- Converting to new COM methods
             'sEmailField$ = oMF.FileCode(oMF.FileIndex(sContacts), "Correspondence", 8)
             sEmailField$ = oMF.TableDefs(sContacts$).Code("Correspondence", 8) '|1|
             
             '-- get e-mail address field in above table
             '-- need to verify that field is set
             If Len(sEmailField$) = 0 Then
                Screen.MousePointer = vbNormal
                frmAttach.picSearch.Visible = False
                MsgBox GT$("Staffware App.Correspondence.8 (Email Column) must be set in order to attach items !", 52, 10), vbExclamation, GT$("Staffware Outlook Add-In", 45, 10)
                errmsg$ = GT$("(Invalid Configuration)", 84, 10)
                GoTo done
             Else
             
                '-- verify that email field exist
                On Error Resume Next
                Set ColDef = TableDEF.ColDefs(sEmailField$)
                On Error GoTo 0
                
                If ColDef Is Nothing Then
                   Screen.MousePointer = vbNormal
                   frmAttach.picSearch.Visible = False
                   MsgBox GT$("Staffware App.Correspondence.8 [", 55, 10) & sEmailField$ & GT$("] is not a valid column !", 56, 10), vbExclamation, GT$("Staffware Outlook Add-In", 45, 10)
                   errmsg$ = GT$("(Invalid Configuration)", 84, 10)
                   GoTo done
                Else
                   Set ColDef = Nothing
                
                   '-- create a sql object
                   '-- Converting to new COM method.
                   'Set DS = oMF.CreateDataObject
                   Set ds = oMF.CreateDataSet()
                   ds.TableList = sContacts$
                   ds.CursorType = 0 ' mfCursorFowardOnly
                   
                   '-- execute the statment for this e-mail
                   ds.Statement = "Select * From " & TableDEF.Name(0) & " where " & sEmailField$ & " = '" & EMailAddress$ & "'" '|1||2|
                   ds.Execute
                   
                   If ds.ErrorCode = 0 Then
                   
                      '-- get parent RecordID
                      ParentRecID$ = ds.GetColValue(SysParentCol$, 1)
                      
                      '-- get parent table
                      ParentTable$ = ds.GetColValue(ParentTableCol$, 1)
                      
                      If Len(ParentTable$) = 0 Then
                        ParentTable$ = oMF.RootForm.Data.PrimaryTable.Name
                        If ParentTable$ = "" Then GoTo BadParent
                      End If
                        
                      '-- Converting to new COM property
                      'Set TableDEF = oMF.Tables(ParentTable$)
                      Set TableDEF = oMF.TableDefs(ParentTable$)
                      'SysRecordCol$ = TableDEF.SystemColumn(TableDEF.TableId, 1, True)
                      'SysRecordCol$ = TableDEF.SystemColumnName(TableDEF.TableId, sweSysRecordID)
                      SysRecordCol$ = TableDEF.SystemColumnName(sweSysRecordID)
                      'ParentDisplayCol$ = TableDEF.SystemColumn(TableDEF.TableId, 4, True)
                      'ParentDisplayCol$ = TableDEF.SystemColumnName(TableDEF.TableId, sweDefaultDisplay)
                      ParentDisplayCol$ = TableDEF.SystemColumnName(sweDefaultDisplay)
                      
                      '-- record may not contain parent table field
                      If Len(ParentTable$) = 0 Then GoTo BadParent:
                      
                      '-- Converting to new COM property
                      'Set CDS = oMF.CreateDataObject
                      Set CDS = oMF.CreateDataSet()
                      CDS.TableList = ParentTable$
                      CDS.CursorType = 0 ' mfCursorFowardOnly
                      
                      '-- execute the statment for this e-mail
                      CDS.Statement = "Select * From {@Table(" & ParentTable$ & ")@} where " & SysRecordCol$ & " = '" & ParentRecID$ & "' ORDER BY " & SysRecordCol$ '|1||2||4|
                      CDS.Execute
                      
                                                               
                      '-- client was found
                      If CDS.ErrorCode = 0 Then
                         
                         '-- get client name (Use sysrecord id if not found)
                         If Len(ParentDisplayCol$) Then
                            ClientName$ = CDS.GetColValue(ParentDisplayCol$, 1)
                         Else
                            ClientName$ = ParentRecID$
                         End If
                         
                         '-- stock textboxes
                         '-- put client name into errmsg
                         errmsg$ = ClientName$
                         
                         '-- stock labels
                         frmAttach.lblClientFile = ParentTable$
                         frmAttach.lblSysRecID = ParentRecID$
                         
                         '-- show the file
                          FindContact = True
                      Else
    BadParent:
                         '-- contact didn't exist
                         Screen.MousePointer = vbNormal
                         frmAttach.picSearch.Visible = False
                         MsgBox GT$("A contact with the e-mail address [", 64, 10) & EMailAddress$ & GT$("] exist", 65, 10) & vbCrLf & GT$("but it's parent record could not be obtained !", 66, 10), vbExclamation, GT$("Staffware Outlook Add-In", 45, 10)
                         errmsg$ = GT$("(No Parent Record)", 98, 10)
                      End If
                   Else
                      '-- contact didn't exist
                      Screen.MousePointer = vbNormal
                      
                      
                      '-- contact not found
                      errmsg$ = GT$("(Client not found)", 69, 10)
                      
                      '-- contact didn't exist
                      Screen.MousePointer = vbNormal
                      
                   End If
                   
                End If
             End If
          End If
       End If
       
    done:
          '-- clear everything
          Set ds = Nothing
          Set CDS = Nothing
          Set TableDEF = Nothing
          
          
          '-- set text (or client name if found)
          frmAttach.tbxClientName.Text = errmsg$
          
          
          '-- restore pointer
          Screen.MousePointer = vbNormal
       
    End Function
    Sub AttachItem()
    
       Dim MyItem As Outlook.MailItem
       Dim WorkItem As Outlook.MailItem
       Dim DeletedItemsFolder As Outlook.MAPIFolder
       Dim TempFolder As Outlook.MAPIFolder
       Dim myAttachment As Outlook.Attachment
       Dim TempFile$, TempPath$
       Dim OldPointer
       Dim retLen As Long
       Dim i As Long
       
       
       '-- set hourglass
       OldPointer = Screen.MousePointer
       Screen.MousePointer = vbHourglass
       
       
       '-- get ExportFile Name (use windows temporary directory)
       TempPath$ = String$(255, 0)
       retLen = GetTempPath(Len(TempPath$), TempPath$)
       TempPath$ = Left$(TempPath$, retLen)
       '-- add trailing backspace
       If Right$(TempPath$, 1) <> "\" Then
          TempPath$ = TempPath$ & "\"
       End If
       TempFile$ = TempPath$ & "mfol2000.msg" '|1|
       
       '-- get current item
       Set MyItem = oApp.ActiveInspector.CurrentItem
       
       '-- make copy of item
       Set WorkItem = MyItem.Copy
              
       '-- create temporary folder and move copy to it
       Set DeletedItemsFolder = oNS.GetDefaultFolder(olFolderDeletedItems)
    
       '-- delete the temporary folder
       For i = 1 To DeletedItemsFolder.Folders.count
          If DeletedItemsFolder.Folders(i).Name = GT$("Staffware Temporary Folder", 71, 10) Then
             DeletedItemsFolder.Folders(i).Delete
             Exit For
          End If
       Next i
       
       Set TempFolder = DeletedItemsFolder.Folders.Add(GT$("Staffware Temporary Folder", 71, 10))
       Set WorkItem = WorkItem.Move(TempFolder)
    
       '-- handle deletion of attachments
       For i = frmAttach.lbxAttachments.ListCount - 1 To 0 Step -1
          '-- get each attachment
          Set myAttachment = WorkItem.Attachments(i + 1)
          '-- see if it is uncheck (delete if not)
          If Val(frmAttach.chkAttachments.Value) = False Or frmAttach.lbxAttachments.Selected(i) = False Then
             myAttachment.Delete
          End If
       Next i
          
          
       '-- kill any previous work file
       On Error Resume Next
       Kill TempFile$
       On Error GoTo 0
          
       '-- save the message to temp msg file
       WorkItem.SaveAs TempFile$, 3
       
       '-- actually attach the file
       Call oMF.AttachFile(TempFile$, frmAttach.tbxDescription, frmAttach.tbxKeywords, frmAttach.lblClientFile, frmAttach.lblSysRecID)
       
                                  
       '-- kill temp file
       On Error Resume Next
       Kill TempFile$
       On Error GoTo 0
       
       '-- delete temporary folder
       TempFolder.Delete
       
       '-- restore pointer
       Screen.MousePointer = OldPointer
    
    End Sub
    Sub SearchClient()
    
       '-- performs simple search for client
       Dim x As Integer
       Dim errmsg$
       
       
       '-- set text (or client name if found)
       frmAttach.tbxClientName.Text = GT$("Searching ....", 73, 10)
       frmAttach.tbxClientName.Refresh
       
       '-- setup search icon picturebox
       frmAttach.picSearch.Picture = LoadPicture("")
       frmAttach.picSearch.Visible = True
       frmAttach.picSearch.Refresh
       
       '-- disable buttons when searching
       frmAttach.btnAdvancedFind.Enabled = False
       
       frmAttach.btnClose.Enabled = False
       frmAttach.Timer.Enabled = True
       frmAttach.lstSearch.Enabled = False
       frmAttach.lstSearch.Refresh
       
       Dim StartTime As Single
       Dim OldPointer As Long
       
       OldPointer = Screen.MousePointer
       Screen.MousePointer = vbHourglass
       
       
       StartTime = GetTickCount()
       Do Until GetTickCount - StartTime > 1000
          DoEvents
       Loop
      
       Dim EMailAddress$
       
       EMailAddress$ = frmAttach.lstSearch.List(frmAttach.lstSearch.ListIndex)
       x = InStr(EMailAddress$, vbTab)
       '-- remove trailing display name
       If x Then
          EMailAddress$ = Left$(EMailAddress$, x - 1)
       End If
       
       If FindContact(EMailAddress$, errmsg$) = True Then
          
          frmAttach.lstSearch.Enabled = True
          frmAttach.Timer.Enabled = False
          frmAttach.picSearch.Visible = False
          frmAttach.btnAdvancedFind.Enabled = True
          
          frmAttach.btnClose.Enabled = True
          frmAttach.btnAttach.Enabled = True
          '-- set focus to attach button
          frmAttach.btnAttach.SetFocus
       Else
          frmAttach.lstSearch.Enabled = True
          frmAttach.Timer.Enabled = False
          frmAttach.picSearch.Visible = False
          frmAttach.picSearch.Refresh
          frmAttach.btnAdvancedFind.Enabled = True
          
          frmAttach.btnClose.Enabled = True
          '-- set focus to listbox
          frmAttach.lstSearch.SetFocus
       End If
    End Sub
    Public Function AdvFindContact(ByVal EMailAddress$, ByVal DisplayName$, errmsg$) As Boolean
       '-- dim variables
       Dim i As Long
       Dim OldPointer
       Dim MyItem As MailItem
       Dim WorkItem As MailItem
       
       Dim sContacts$, sEmailField$
       
       Dim ParentRecID$
       'Dim TableDEF As mfTableDef
    '   #If USEMKTFORCEREF = 0 Then
    '   Dim TableDEF As Object
    '   Dim ds As Object
    '   Dim CDS As Object
    '   Dim ColDef As Object
    '   #Else
       Dim TableDEF As StaffwareCRM.sweTableDef
       Dim ds As StaffwareCRM.sweDataSet
       Dim CDS As StaffwareCRM.sweDataSet
       Dim ColDef As StaffwareCRM.sweColDef
    '   #End If
       Dim SysParentCol$
       Dim SysRecordCol$
       Dim ParentTable$
       Dim ParentTableCol$
       Dim ParentDisplayCol$
       Dim ParentTableAlias$
       Dim ClientName$
       Dim Item$
       Dim SysRouteCol$
       
       'Dim DS As mfDataSet
       'Dim CDS As mfDataSet
       'Dim ColDef As mfColDef
       
       
       Dim stmt$, Strn$
       Dim DisplayCol$
       Dim RouteCodeCol$
       
       Dim myAttachment As Outlook.Attachment
       Dim TmpAttachment As Outlook.Attachment
       Dim retLen As Long
       Dim cnt
       Dim TempRecID As Long
       Dim CheckRecipient As Boolean
       Dim NewIndex As Long
       Dim TempFolder As MAPIFolder
       Dim DeletedItemsFolder As MAPIFolder
       Dim x, DomainName$
       Dim PassCount As Integer
       ReDim rContacts(0) As CONTACTSTRUCT
       Dim PrevSysREcordID$
       Dim ContactSysREcordID$
       
       '-- store pointer and set to hourglass
       OldPointer = Screen.MousePointer
       Screen.MousePointer = vbHourglass
       
       rContactsCount = 0
       frmSearch.trFound.Clear
       
       '-- get domainname
       x = InStr(EMailAddress$, "@")
       If x Then
          DomainName$ = Mid$(EMailAddress$, x + 1)
       End If
       
                
       '-- get contact field information
       '-- Converting to using new COM methods
       'sContacts$ = oMF.AppCode(oMF.ConfigIndex("MarketForce", 1), 256) '"mfAppConfig
       sContacts$ = oMF.Code(256) '"mfAppConfig
       
       '-- make sure the contacts table is set
       If Len(sContacts$) = 0 Then
          Screen.MousePointer = vbNormal
          frmAttach.picSearch.Visible = False
          MsgBox GT$("Staffware App.Config.256 (Contacts Table) must be set in order to attach items !", 44, 10), vbExclamation, GT$("Staffware Outlook Add-In", 45, 10)
          errmsg$ = GT$("(Invalid Configuration)", 84, 10)
          GoTo done
       Else
          '-- check for contacts table (get sysparentID field name)
          On Error Resume Next
          '-- Converting to new COM property.
          'Set TableDEF = oMF.Tables(sContacts$)
          Set TableDEF = oMF.TableDefs(sContacts$)
          On Error GoTo 0
          
          '-- make sure table specifed is valie
          If TableDEF Is Nothing Then
             Screen.MousePointer = vbNormal
             frmAttach.picSearch.Visible = False
             MsgBox GT$("Unable to locate table [", 77, 10) & sContacts$ & GT$("] specified in Staffware App.Config.256 !", 78, 10), vbExclamation, GT$("Staffware Outlook Add-In", 45, 10)
             errmsg$ = GT$("(Invalid Configuration)", 84, 10)
             GoTo done
          Else
             '-- get columns
             '-- Converting to use latest COM object model.
    '         SysParentCol$ = TableDEF.SystemColumn(TableDEF.TableId, 3, True)
    '         ParentTableCol$ = TableDEF.SystemColumn(TableDEF.TableId, 7, True)
    '         RouteCodeCol$ = TableDEF.SystemColumn(TableDEF.TableId, 2, True)
             'SysParentCol$ = TableDEF.SystemColumnName(TableDEF.TableId, sweSysParentID)
             SysParentCol$ = TableDEF.SystemColumnName(sweSysParentID)
             'ParentTableCol$ = TableDEF.SystemColumnName(TableDEF.TableId, sweSysParentTable)
             ParentTableCol$ = TableDEF.SystemColumnName(sweSysParentTable)
             'RouteCodeCol$ = TableDEF.SystemColumnName(TableDEF.TableId, sweSysRouting)
             RouteCodeCol$ = TableDEF.SystemColumnName(sweSysRouting)
                      
             '-- get column configured as e-mail field
             '-- Converting to new COM method
             'sEmailField$ = oMF.FileCode(oMF.FileIndex(sContacts), "Correspondence", 8)
             sEmailField$ = TableDEF.Code("Correspondence", 8) '|1|
             
             '-- get e-mail address field in above table
             '-- need to verify that field is set
             If Len(sEmailField$) = 0 Then
                Screen.MousePointer = vbNormal
                frmAttach.picSearch.Visible = False
                MsgBox GT$("Staffware App.Correspondence.8 (Email Column) must be set in order to attach items !", 52, 10), vbExclamation, GT$("Staffware Outlook Add-In", 45, 10)
                errmsg$ = GT$("(Invalid Configuration)", 84, 10)
                GoTo done
             Else
             
                '-- verify that email field exist
                On Error Resume Next
                Set ColDef = TableDEF.ColDefs(sEmailField$)
                On Error GoTo 0
                
                If ColDef Is Nothing Then
                   Screen.MousePointer = vbNormal
                   frmAttach.picSearch.Visible = False
                   MsgBox GT$("Staffware App.Correspondence.8 [", 55, 10) & sEmailField$ & GT$("] is not a valid column !", 86, 10), vbExclamation, GT$("Staffware Outlook Add-In", 45, 10)
                   errmsg$ = GT$("(Invalid Configuration)", 84, 10)
                   GoTo done
                Else
                   
    again:
                   '-- first pass look for display name
                   '-- Converting to use latest COM object model.
                   'DisplayCol$ = TableDEF.SystemColumn(TableDEF.TableId, 4, True)
                   'DisplayCol$ = TableDEF.SystemColumnName(TableDEF.TableId, sweDefaultDisplay)
                   DisplayCol$ = TableDEF.SystemColumnName(sweDefaultDisplay)
                   If PassCount = 0 Then
                      If Len(DisplayName$) = 0 Then
                         PassCount = PassCount + 1
                         GoTo again
                      Else
                         stmt$ = "Select * From " & TableDEF.Name(0) & " where " & DisplayCol$ & " Like '" & DisplayName$ & "%'" '|1||2||3|
                      End If
                   Else
                      '-- reset table def because it will be client at this point
                      Set TableDEF = Nothing
                      '-- Converting to new COM property
                      'Set TableDEF = oMF.Tables(sContacts$)
                      Set TableDEF = oMF.TableDefs(sContacts$)
                      '-- second pass look for domain name
                      stmt$ = "Select * From " & TableDEF.Name(0) & " where " & sEmailField$ & " Like '%" & DomainName$ & "'" '|1||2||3|
    
                   End If
                   
                   '-- Converting to use latest COM object model
                   'ContactSysREcordID$ = TableDEF.SystemColumn(TableDEF.TableId, 1, True)
                   'ContactSysREcordID$ = TableDEF.SystemColumnName(TableDEF.TableId, sweSysRecordID)
                   ContactSysREcordID$ = TableDEF.SystemColumnName(sweSysRecordID)
                                  
                   Set ColDef = Nothing
                
                   '-- create a sql object
                   Set ds = Nothing
                   '-- Converting to use new COM object model property.
                   'Set DS = oMF.CreateDataObject
                   Set ds = oMF.CreateDataSet()
                   ds.TableList = sContacts$
                   ds.CursorType = 0 'mfCursorFowardOnly
                   
                   '-- execute the statment for this e-mail
                   ds.Statement = stmt$
                   ds.Execute
                   
                   '-- error code is zero
                   Do While ds.ErrorCode = 0
                   
                      rContactsCount = rContactsCount + 1
                      ReDim Preserve rContacts(rContactsCount) As CONTACTSTRUCT
                      
                      
                      If PassCount = 0 Then
                         'Item$ = "Display Name Matches" & vbTab & DS.GetColValue(DisplayCol$, mfDisplayFormat)
                         
                         rContacts(rContactsCount).DisplayNameMatch = True
                         rContacts(rContactsCount).ContactEmail = ds.GetColValue(sEmailField$, 2) ' mfDisplayFormat
                         rContacts(rContactsCount).ContactName = ds.GetColValue(DisplayCol$, 2) ' mfDisplayFormat
                         rContacts(rContactsCount).ContactSysREcordID = ds.GetColValue(ContactSysREcordID$, 2) ' mfDisplayFormat
                      Else
                         'Item$ = "Domain Name Matches" & vbTab & DS.GetColValue(sEmailField$, mfDisplayFormat)
                         rContacts(rContactsCount).DisplayNameMatch = False
                         rContacts(rContactsCount).ContactEmail = ds.GetColValue(sEmailField$, 2)
                         rContacts(rContactsCount).ContactName = ds.GetColValue(DisplayCol$, 2)
                         rContacts(rContactsCount).ContactSysREcordID = ds.GetColValue(ContactSysREcordID$, 2)
                      End If
                                                                         
                      '-- get parent RecordID
                      ParentRecID$ = ds.GetColValue(SysParentCol$, 1) ' mfSystemFormat
                      
                      
                      '-- get parent table
                      ParentTable$ = ds.GetColValue(ParentTableCol$, 1)
                      If Len(ParentTable$) Then
                         '-- Converting to using new COM method.
                         'Set TableDEF = oMF.Tables(ParentTable$)
                         Set TableDEF = oMF.TableDefs(ParentTable$)
    '                     SysRecordCol$ = TableDEF.SystemColumn(TableDEF.TableId, 1, True)
    '                     ParentDisplayCol$ = TableDEF.SystemColumn(TableDEF.TableId, 4, True)
                         'SysRecordCol$ = TableDEF.SystemColumnName(TableDEF.TableId, sweSysRecordID)
                         SysRecordCol$ = TableDEF.SystemColumnName(sweSysRecordID)
                         'ParentDisplayCol$ = TableDEF.SystemColumnName(TableDEF.TableId, sweDefaultDisplay)
                         ParentDisplayCol$ = TableDEF.SystemColumnName(sweDefaultDisplay)
                         '-- record may not contain parent table field
                         If Len(ParentTable$) = 0 Then GoTo BadParent:
                         
                         Set CDS = Nothing
                         '-- Converting to using new COM method.
                         'Set CDS = oMF.CreateDataObject
                         Set CDS = oMF.CreateDataSet()
                         CDS.TableList = ParentTable$
                         CDS.CursorType = 0 'mfCursorFowardOnly
                         
                         '-- execute the statment for this e-mail
                         CDS.Statement = "Select * From {@Table(" & ParentTable$ & ")@} where " & SysRecordCol$ & " = '" & ParentRecID$ & "' ORDER BY " & SysRecordCol$ '|1||2||4|
                         CDS.Execute
                         
                                                                  
                         '-- client was found
                         If CDS.ErrorCode = 0 Then
                            
                            '-- get client name (Use sysrecord id if not found)
                            If Len(ParentDisplayCol$) Then
                               ClientName$ = CDS.GetColValue(ParentDisplayCol$, 1) '  mfSystemFormat
                            End If
                            
                                                 
                            '-- stock labels
                            frmAttach.lblClientFile = ParentTable$
                            frmAttach.lblSysRecID = ParentRecID$
                                                 
                            '-- set parent info
                            rContacts(rContactsCount).ClientName$ = ClientName$
                            rContacts(rContactsCount).ClientSysRecordID = ParentRecID$
                            rContacts(rContactsCount).ParentTable = ParentTable
                            rContacts(rContactsCount).SysRoute = CDS.GetColValue(RouteCodeCol$, 1) 'mfSystemFormat
                            
                            ClientName$ = ""
                            ParentRecID$ = ""
                            ParentTable = ""
                            
                            '-- show the file
                             AdvFindContact = True
                         Else
                          rContactsCount = rContactsCount - 1
                         End If
                      Else
                         '-- decrement contact count
                         rContactsCount = rContactsCount - 1
    BadParent:
                         errmsg$ = GT$("(No Parent Record)", 98, 10)
                      End If
                      
    
                      
                      ds.NextRow
                   Loop
                   '-- contact didn't exist
                   Screen.MousePointer = vbNormal
                End If
             End If
          End If
       End If
       
    done:
    
          PassCount = PassCount + 1
          '-- clear everything
          Set ds = Nothing
          Set CDS = Nothing
          
          '-- look for domain name searches
          If PassCount = 1 And errmsg$ = "" Then GoTo again
          Set TableDEF = Nothing
          Set ColDef = Nothing
          
          Dim tmp As CONTACTSTRUCT
          Dim bMoved As Boolean
          
          If rContactsCount > 0 Then
             '-- bubble sort if more than 1 record
             If rContactsCount > 1 Then
                Do
                   bMoved = False
                   For i = 1 To rContactsCount - 1
                      If rContacts(i).ClientName & rContacts(i).ContactName > rContacts(i + 1).ClientName & rContacts(i + 1).ContactName Then
                         tmp = rContacts(i)
                         rContacts(i) = rContacts(i + 1)
                         rContacts(i + 1) = tmp
                         bMoved = True
                      End If
                   Next i
                Loop While bMoved = True
             End If
             
             
             '-- stock tree list
             Dim LastClientName$
             Dim LastParent As Integer
             frmSearch.trFound.Redraw = False
             frmSearch.trFound.Clear
             
             For i = 1 To rContactsCount
                If rContacts(i).ClientName <> LastClientName$ Then
                   frmSearch.trFound.AddItem rContacts(i).ClientName
                   LastParent = frmSearch.trFound.NewIndex
                   frmSearch.trFound.ItemIntValue(LastParent) = i
                End If
                            
                Dim DisplayStrn$
                Strn$ = ""
                If Len(rContacts(i).ContactName) Then
                   Strn$ = rContacts(i).ContactName & " - "
                End If
                Strn$ = Strn$ & rContacts(i).ContactEmail
                            
                '-- add the contact
                If PrevSysREcordID <> rContacts(i).ContactSysREcordID Then
                
                   If UCase$(rContacts(i).ContactName) = UCase$(DisplayName$) And UCase$(rContacts(i).ContactEmail) = UCase$(EMailAddress$) Then
                      frmSearch.trFound.AddItem Strn$ & GT$(" (Exact Match)", 99, 10), LastParent
                      NewIndex = frmSearch.trFound.NewIndex
                   ElseIf rContacts(i).DisplayNameMatch = True Then
                      frmSearch.trFound.AddItem Strn$ & GT$(" (Name matches)", 100, 10), LastParent
                   Else
                      frmSearch.trFound.AddItem Strn$ & GT$(" (Domain matches)", 101, 10), LastParent
                   End If
                   
                   '-- set item int data from contact
                   frmSearch.trFound.ItemIntValue(frmSearch.trFound.NewIndex) = i
                End If
                PrevSysREcordID$ = rContacts(i).ContactSysREcordID
                
                '-- remember last client name
                LastClientName$ = rContacts(i).ClientName
             Next i
             
             '-- turn redraw on
             frmSearch.trFound.Redraw = True
             
             '-- set to exact match or zero
             frmSearch.trFound.ListIndex = NewIndex
             
          Else
             '-- not found so disable everything
             frmSearch.trFound.AddItem GT$("No matches found ...", 102, 10)
             frmSearch.btnSetClient.Enabled = False
             frmSearch.btnUpdate.Enabled = False
             frmSearch.btnCreateContact = False
          End If
          
          
          '-- restore pointer
          Screen.MousePointer = vbNormal
       
    End Function
    Sub UpdateContact(ByVal bNew As Boolean)
       
       '-- update or adds a new contact record
       '-- dim variables
       
       '-- returns sysrecordID of new or updated contact
       
       Dim i As Long
       Dim OldPointer
       Dim MyItem As MailItem
       Dim WorkItem As MailItem
       
       Dim sContacts$, sEmailField$
       
       Dim ParentRecID$
       'Dim TableDEF As mfTableDef
    '   #If USEMKTFORCEREF = 0 Then
    '   Dim TableDEF As Object
    '   Dim ds As Object
    '   Dim CDS As Object
    '   Dim ColDef As Object
    '   #Else
       Dim TableDEF As StaffwareCRM.sweTableDef
       Dim ds As StaffwareCRM.sweDataSet
       Dim CDS As StaffwareCRM.sweDataSet
       Dim ColDef As StaffwareCRM.sweColDef
    '   #End If
       Dim SysParentCol$
       Dim SysRecordCol$
       Dim ParentTable$
       Dim ParentTableCol$
       Dim ParentDisplayCol$
       Dim ParentTableAlias$
       Dim ClientName$
       Dim Item$
       Dim SysRouteCol$, ContactSysREcordID$
       Dim EMailCol$
       
       'Dim DS As mfDataSet
       'Dim CDS As mfDataSet
       'Dim ColDef As mfColDef
       
       Dim stmt$
       Dim DisplayCol$
       
       Dim retLen As Long
       Dim cnt
       Dim TempRecID As Long
       Dim CheckRecipient As Boolean
       
       Dim TempFolder As MAPIFolder
       Dim DeletedItemsFolder As MAPIFolder
       Dim x, DomainName$
       Dim PassCount As Integer
       Dim RouteCodeCol$
       
       Dim EMailAddress$, DisplayName$
       EMailAddress$ = frmAttach.lstSearch.List(frmAttach.lstSearch.ListIndex)
       x = InStr(EMailAddress$, vbTab)
       
       '-- extract DisplayName
       If x Then
          DisplayName$ = Mid$(EMailAddress$, x + 1)
          EMailAddress$ = Left$(EMailAddress$, x - 1)
       End If
       
       Dim LI As Long
       Dim idx As Long
       LI = frmSearch.trFound.ListIndex
       idx = frmSearch.trFound.ItemIntValue(LI)
       
       
       '-- show contact form
       If bNew = True Then
          '-- next contact
          frmContact.Caption = GT$("Create New Contact Record", 103, 10)
          
          If Len(DisplayName$) Then
             frmContact.tbxContactName.Text = DisplayName$
             frmContact.tbxContactName.ForeColor = 255
          Else
             frmContact.tbxContactName.Text = ""
             frmContact.tbxContactName.ForeColor = vbWindowText
          End If
          
          frmContact.tbxEmailAddress.Text = EMailAddress$
          frmContact.tbxEmailAddress.ForeColor = 255
       Else
          '-- existing contact
          If Len(Trim$(rContacts(idx).ContactName)) Then
             frmContact.tbxContactName = rContacts(idx).ContactName
             frmContact.tbxContactName.ForeColor = vbWindowText
          Else
             frmContact.tbxContactName = DisplayName$
             frmContact.tbxContactName.ForeColor = 255
          End If
          
          If Len(Trim$(rContacts(idx).ContactEmail)) Then
             frmContact.tbxEmailAddress = rContacts(idx).ContactEmail
             frmContact.tbxEmailAddress.ForeColor = vbWindowText
          Else
             frmContact.tbxEmailAddress = EMailAddress
             frmContact.tbxEmailAddress.ForeColor = 255
          End If
          frmContact.Caption = GT$("Update Existing Contact Record", 104, 10)
       End If
       
       '-- show contact form
       Call ShowModal(frmContact)
       'frmContact.Show 1
       
       '-- update/add record if not cancelled
       If frmContact.lblOperation <> GT$("CANCEL", 206, 10) Then
          
          '-- get contact field information
          '-- Converting to using the new COM method.
          'sContacts$ = oMF.AppCode(oMF.ConfigIndex("MarketForce", 1), 256) 'mfAppConfig
          sContacts$ = oMF.Code(256)
          
          '-- check for contacts table (get sysparentID field name)
          On Error Resume Next
          '-- Converting to using the new COM property
          'Set TableDEF = oMF.Tables(sContacts$)
          Set TableDEF = oMF.TableDefs(sContacts$)
          On Error GoTo 0
             
          '-- get columns
          'SysParentCol$ = TableDEF.SystemColumnName(TableDEF.TableId, 3, True)
          'ParentTableCol$ = TableDEF.SystemColumnName(TableDEF.TableId, 7, True)
          SysParentCol$ = TableDEF.SystemColumnName(3)
          ParentTableCol$ = TableDEF.SystemColumnName(7)
          
          
          'RouteCodeCol$ = TableDEF.SystemColumnName(TableDEF.TableId, 2, True)
          'ContactSysREcordID$ = TableDEF.SystemColumnName(TableDEF.TableId, 1, True)
          RouteCodeCol$ = TableDEF.SystemColumnName(2)
          ContactSysREcordID$ = TableDEF.SystemColumnName(1)
          
          
          '-- get column configured as e-mail field
          '-- Converting to using new COM method.
          'EMailCol$ = oMF.FileCode(oMF.FileIndex(sContacts), "Correspondence", 8)
          EMailCol$ = TableDEF.Code("Correspondence", 8) '|1|
          'DisplayCol$ = TableDEF.SystemColumnName(TableDEF.TableId, 4, True)
          DisplayCol$ = TableDEF.SystemColumnName(4)
          
                            
          '-- get particular record
          If bNew = True Then
             '-- create empty set
             stmt$ = "Select * From " & TableDEF.Name(0) & " where " & ContactSysREcordID$ & " = 'EmptySet'" '|1||2||3|
          Else
             '-- get specified record
             stmt$ = "Select * From " & TableDEF.Name(0) & " where " & ContactSysREcordID$ & " = '" & rContacts(idx).ContactSysREcordID & "'" '|1||2|
          End If
          
          
          '-- create a sql object
          Set ds = Nothing
          '-- Converting to using new COM method.
          'Set DS = oMF.CreateDataObject
          Set ds = oMF.CreateDataSet()
          ds.TableList = sContacts$
          ds.CursorType = 0 ' mfCursorFowardOnly
          ds.Statement = stmt$
          ds.Execute
          
          '-- execute the statment for this e-mail
          If bNew = True Then
             ds.ModeAdd
          Else
             ds.ModeUpdate
          End If
          
          '-- set data
          ds.PutColValue EMailCol$, frmContact.tbxEmailAddress, 4 ' mfEditFormat
          ds.PutColValue DisplayCol$, frmContact.tbxContactName, 4 ' mfEditFormat
          ds.PutColValue SysParentCol$, rContacts(idx).ClientSysRecordID, 4 ' mfEditFormat
          ds.PutColValue ParentTableCol, rContacts(idx).ParentTable, 4 ' mfEditFormat
          ds.PutColValue RouteCodeCol$, rContacts(idx).SysRoute, 4 ' mfEditFormat
          
          '-- save record
          ds.ModeSave
          
          Set ds = Nothing
          Set TableDEF = Nothing
       End If
    End Sub
    '-- Don't need this since the basic modules have been added in for pathmath,apiutil,etc.
    'Sub CenterForm(frm As Form)
    '   '-- center form
    '   frm.Move (Screen.Width - frm.Width) \ 2, (Screen.Height - frm.Height) \ 2
    'End Sub
    
    Public Sub SaveSettings()
       '-- save preferences
       Call SaveSetting("Staffware Outlook AddIn", "Settings", "UserEMailAddress", gUserEmailAddress$) '|1||2||3|
       Call SaveSetting("Staffware Outlook AddIn", "Settings", GT$("AutoSearch", 144, 10), gAutoSearch) '|1||2|
       Call SaveSetting("Staffware Outlook AddIn", "Settings", "CommandLine", gCommandLine$) '|1||2||3|
       Call SaveSetting("Staffware Outlook AddIn", "Settings", "SkipIntroductionPage", CInt(gSkipIntroductionPage)) '|1||2||3|
       Call SaveSetting("Staffware Outlook AddIn", "Settings", "SkipFieldSearchPage", CInt(gSkipFieldSearchPage)) '|1||2||3|
       Call SaveSetting("Staffware Outlook AddIn", "Settings", "SkipLastPage", CInt(gSkipFinalPage)) '|1||2||3|
       Call SaveSetting("Staffware Outlook AddIn", "Settings", "SearchEMail", CInt(gSearchEMail)) '|1||2||3|
       Call SaveSetting("Staffware Outlook AddIn", "Settings", "SearchCompany", CInt(gSearchCompany)) '|1||2||3|
       Call SaveSetting("Staffware Outlook AddIn", "Settings", "SearchTelephone", CInt(gSearchTelephone)) '|1||2||3|
    End Sub
    Sub LoadSettings()
       '-- load preferences prefs
       gUserEmailAddress$ = GetSetting("Staffware Outlook AddIn", "Settings", "UserEMailAddress", "") '|1||2||3|
       gAutoSearch = CInt(GetSetting("Staffware Outlook AddIn", "Settings", GT$("AutoSearch", 144, 10), "0")) '|1||2|
       gCommandLine$ = GetSetting("Staffware Outlook AddIn", "Settings", "CommandLine", "") '|1||2||3|
       gSkipIntroductionPage = CInt(GetSetting("Staffware Outlook AddIn", "Settings", "SkipIntroductionPage", "0")) '|1||2||3|
       gSkipFieldSearchPage = CInt(GetSetting("Staffware Outlook AddIn", "Settings", "SkipFieldSearchPage", "0")) '|1||2||3|
       gSkipFinalPage = CInt(GetSetting("Staffware Outlook AddIn", "Settings", "SkipLastPage", "0")) '|1||2||3|
       gSearchEMail = CInt(GetSetting("Staffware Outlook AddIn", "Settings", "SearchEMail", "0")) '|1||2||3|
       gSearchCompany = CInt(GetSetting("Staffware Outlook AddIn", "Settings", "SearchCompany", "0")) '|1||2||3|
       gSearchTelephone = CInt(GetSetting("Staffware Outlook AddIn", "Settings", "SearchTelephone", "0")) '|1||2||3|
       
       
       
    End Sub
    
    Function StripNonNumbers(ByVal Strn$) As String
       '-- this function strips all the non-numeric characters from the passed string
       Dim Newstrn$
       Dim i As Long
       For i = 1 To Len(Strn$)
          If InStr("0123456789", Mid$(Strn$, i, 1)) Then
             Newstrn$ = Newstrn$ + Mid$(Strn$, i, 1)
          End If
       Next i
       StripNonNumbers = Newstrn$
    
    End Function
    

    Thanks Marzio

    Tuesday, November 11, 2014 2:52 PM
  • What line of code exactly generates the error?

    Could you please reproduce the issue with a simple project where you call the GetDefaultfolder?

    Tuesday, November 11, 2014 2:59 PM
  • Hello Eugene,

    the line who generate error is the following:

    Set DeletedItemsFolder = oNS.GetDefaultFolder(olFolderDeletedItems)

    Marzio

    Tuesday, November 11, 2014 3:04 PM
  • Where did you get the oNS object? How do you create an instance of the Application class?
    Tuesday, November 11, 2014 3:06 PM
  • At the top of the module

    DefLng A-Z
    Option Explicit

    Public oCDO As Object
    Public oApp As Outlook.Application
    Public oNS As Outlook.NameSpace

    remeber in Outlook version 2003/2007/2010 is all OK the problem is only with Outlook 2013

    Thanks

    Marzio

    Tuesday, November 11, 2014 3:12 PM
  • That is the declaration. Where did you instantiate them?

    Again, I'd suggest creating a new sample application which can reproduce the issue. Thus, we will find the cause faster.

    Tuesday, November 11, 2014 3:16 PM
  • Hi Marzio48,

    As Eugene’s said that you’d better do test with simple code to check whether it works and how oNS initialized.

    About GetDefaultFolder method, please refer to:

    # NameSpace.GetDefaultFolder Method (Outlook)

    http://msdn.microsoft.com/en-us/library/office/ff866724(v=office.15).aspx

    Best Regards

    Starain


    We are trying to better understand customer views on social support experience, so your participation in this interview project would be greatly appreciated if you have time. Thanks for helping make community forums a great place.
    Click HERE to participate the survey.

    Wednesday, November 12, 2014 8:27 AM
    Moderator
  • Hello Eugene,

    the follwing sample run in Outlook 2003/2007/2010 non in Outlook 2013

    DefLng A-Z
    Option Explicit
    
    
    Sub Main()
    
    Dim oApp As Outlook.Application
    Dim oNS As Outlook.NameSpace
    Set oApp = Outlook.Application
       Dim MyItem As Outlook.MailItem
       Dim WorkItem As Outlook.MailItem
       Dim DeletedItemsFolder As Outlook.MAPIFolder
       
       Dim i As Long
       Set oNS = oApp.GetNamespace("MAPI")
       
       Set DeletedItemsFolder = oNS.GetDefaultFolder(olFolderDeletedItems)
    
       '-- delete the temporary folder
       For i = 1 To DeletedItemsFolder.Folders.Count
          If DeletedItemsFolder.Folders(i).Name = "" Then
    '         DeletedItemsFolder.Folders(i).Delete
             Exit For
          End If
       Next i
    
    End Sub

    Regards

    Marzio

    Wednesday, November 12, 2014 11:13 AM
  • Marzio,

    It is impossible due to the fact that an instance of the Application class is not instantiated in the code:

    Set oApp = Outlook.Application

    You need to replace it with the following line of code:

    Set oApp = New Outlook.Application

    Wednesday, November 12, 2014 11:58 AM
  • I do it but the result is the some.

    I think the problem is olFolderDeletedItems if I replace it with olFolderContacts everything is OK

    Marzio


    • Edited by Marzio48 Wednesday, November 12, 2014 1:13 PM
    Wednesday, November 12, 2014 12:36 PM
  • Does the Deleted Items folder exist?

    Try creating a new profile and test against it.

    Wednesday, November 12, 2014 3:15 PM
  •         

    The following return error

    olFolderConflicts
    olFolderDeletedItems
    olFolderManagedEmail
    olFolderOutbox
    olFolderSentMail
    olFolderServerFailures
    olFolderSuggestedContacts
    olFolderToDo
    olPublicFoldersAllPublicFolders

    This are OK

    olFolderCalendar
    olFolderContacts
    olFolderDrafts
    olFolderInbox
    olFolderJournal
    olFolderJunk
    olFolderLocalFailures
    olFolderManagedEmail
    olFolderNotes
    olFolderSyncIssues
    olFolderTasks
    olFolderRssFeeds


                                                                                                                                                                        
    • Edited by Marzio48 Wednesday, November 12, 2014 4:47 PM
    Wednesday, November 12, 2014 4:39 PM
  • Try to create a new profile in Outlook.

    Do you get the same results on another PC or with a new profile?

    Wednesday, November 12, 2014 4:56 PM
  • with a new profile
    Thursday, November 13, 2014 8:25 AM
  • How did you log in to another profile?

    Did you try to run the code on another machine with Outlook 2013 installed?

    Thursday, November 13, 2014 11:22 AM
  • I start Outlook with another profile.

    I have not tried outlook 2013 on another PC, I install outlook and try.

    Marzio

    Thursday, November 13, 2014 2:40 PM
  • Let me know your results.
    Thursday, November 13, 2014 5:02 PM
  • Hello Eugene,

    i do Tomorrow.

    Ciao

    Thursday, November 13, 2014 6:14 PM
  • The problem is the PC (Windows) where I was testing, I created a new PC just like the first, Windows 7 Professional and Outlook 2013, and the problem does not recur.

    Thank you all for the help.

    Marzio
    Monday, November 17, 2014 9:12 AM
  • That was expected... because I couldn't reproduce the issue on my machines.

    Thank you for letting me know.

    Monday, November 17, 2014 10:37 AM
  • Hi Marzio48,

    >> The problem is the PC (Windows) where I was testing, I created a new PC just like the first, Windows 7 Professional and Outlook 2013, and the problem does not recur

    So, I suggest that you could repair or reinstall the office in the machine that has the issue.

    Best Regards

    Starain


    We are trying to better understand customer views on social support experience, so your participation in this interview project would be greatly appreciated if you have time. Thanks for helping make community forums a great place.
    Click HERE to participate the survey.

    Tuesday, November 18, 2014 9:30 AM
    Moderator
  • Hi Strain,

    I've already reinstalled office with no results, I think I need to reinstall windows.

    Thanks Marzio

    Tuesday, November 18, 2014 11:14 AM