none
Script for outlook RRS feed

  • Question

  • Hi

    I found the following script on the net ( I don't remember where) to launch a template trough a outlook script written in microsoft visual basic for application.

    But it seeems works not very well in fact it sends the template even if office hours are written in to the code (in ex >8 A.M.)

    could someone suggest if is worth?

    PS ALERT I choose language setting for C++ But I dont't really know what language is!!!

    Thanks in advance

    Sub MoveMeIfNecessary(Item As Outlook.MailItem)
      On Error Resume Next
    
      Dim wd As Integer
      Dim h As Integer
      
      wd = Weekday(Date) 'week day: Sunday =1, Monday= 2, ....
      h = Hour(Time)     'Hour: 24 hour format (0-23)
      
      If (wd = 5 Or wd = 7 Or wd = 8 Or h >8 Or h <20) Then
      Item.Move GetFolderByName("Posta in arrivo")
      Item.Save
      End If
      
    End Sub
    
    
     'GetFolderByName
    ' By: Jeff Rockow
    '-------------------------------------------------------------
    ' Purpose: Search the folder tree to get any folder, based on
    '          its name alone
    '-------------------------------------------------------------
    ' Arguments: strFolderName = name of folder to search for
    '-------------------------------------------------------------
    ' Returns: MAPIFolder object if folder exists and is unique,
    '          otherwise Nothing
    '
    '          intFolderCount is also accessible
    '=============================================================
    Public Function GetFolderByName(strFolderName As String, Optional objFolder As Outlook.MAPIFolder, Optional intFolderCount) As MAPIFolder
    Dim objApp As Outlook.Application
    Dim objNS As Outlook.NameSpace
    Dim colStores As Outlook.Folders
    Dim objStore As Outlook.MAPIFolder
    Dim colFolders As Outlook.Folders
    Dim objResult As Outlook.MAPIFolder
    Dim I As Long
     
    On Error Resume Next
      Set objApp = CreateObject("Outlook.Application")
      Set objNS = objApp.GetNamespace("MAPI")
      Set colStores = objNS.Folders
       
      If objFolder Is Nothing Then
        'If objFolder is not passed, assume this is the initial call and cycle through stores
        intFolderCount = 0
        For Each objStore In colStores
          Set objResult = GetFolderByName(strFolderName, objStore, intFolderCount)
          If Not objResult Is Nothing Then Set GetFolderByName = objResult
        Next
      Else
      'Test to see if this folder's name matches the search criteria
        If objFolder.Name = strFolderName Then
          Set GetFolderByName = objFolder
          intFolderCount = intFolderCount + 1
        End If
        Set colFolders = objFolder.Folders
        'Cycle through the sub folders with recursive calls to this function
        For Each objFolder In colFolders
          Set objResult = GetFolderByName(strFolderName, objFolder, intFolderCount)
          If Not objResult Is Nothing Then Set GetFolderByName = objResult
        Next
      End If
      'If two or more folders exist with the same name, set the function to Nothing
      If intFolderCount > 1 Then Set GetFolderByName = Nothing
       
      Set objResult = Nothing
      Set colFolders = Nothing
      Set objNS = Nothing
      Set objApp = Nothing
    End Function
    

    Friday, November 20, 2015 1:13 PM

Answers

  • Solved (apparently) I will confirm in some days.

    I have got two same rules but setted in different manner. For the moment it works.

    Thanks to all

    • Marked as answer by David_JunFeng Wednesday, December 2, 2015 9:02 AM
    Saturday, November 21, 2015 9:56 AM

All replies