*Oliv' que je salut a écrit *:
Fabrice tu peux sans doute utiliser la fonction de règle de message
"executer un script"
Le script doit comporter un argument MailItem (ou MeetingItem) et se
trouver soit dans thisoutlooksession soit dans un module
Sub RunAScriptRuleRoutine(MyMail As MailItem)
Dim strID As String
Dim olNS As Outlook.NameSpace
Dim msg As Outlook.MailItem
strID = MyMail.EntryID
Set olNS = Application.GetNamespace("MAPI")
Set msg = olNS.GetItemFromID(strID)
' do stuff with msg, e.g.
MsgBox msg.Body
Set msg = Nothing
Set olNS = Nothing
End Sub
See http://www.outlookcode.com/d/code/zaphtml.htm#ol2002 for another
example.
http://support.microsoft.com/?kbid06108A+ Oliv
*Oliv' <SUPPRIMERCECIcatteau@ricour-assurances.fr> que je salut a écrit *:
Fabrice tu peux sans doute utiliser la fonction de règle de message
"executer un script"
Le script doit comporter un argument MailItem (ou MeetingItem) et se
trouver soit dans thisoutlooksession soit dans un module
Sub RunAScriptRuleRoutine(MyMail As MailItem)
Dim strID As String
Dim olNS As Outlook.NameSpace
Dim msg As Outlook.MailItem
strID = MyMail.EntryID
Set olNS = Application.GetNamespace("MAPI")
Set msg = olNS.GetItemFromID(strID)
' do stuff with msg, e.g.
MsgBox msg.Body
Set msg = Nothing
Set olNS = Nothing
End Sub
See http://www.outlookcode.com/d/code/zaphtml.htm#ol2002 for another
example.
http://support.microsoft.com/?kbid06108
A+ Oliv
*Oliv' que je salut a écrit *:
Fabrice tu peux sans doute utiliser la fonction de règle de message
"executer un script"
Le script doit comporter un argument MailItem (ou MeetingItem) et se
trouver soit dans thisoutlooksession soit dans un module
Sub RunAScriptRuleRoutine(MyMail As MailItem)
Dim strID As String
Dim olNS As Outlook.NameSpace
Dim msg As Outlook.MailItem
strID = MyMail.EntryID
Set olNS = Application.GetNamespace("MAPI")
Set msg = olNS.GetItemFromID(strID)
' do stuff with msg, e.g.
MsgBox msg.Body
Set msg = Nothing
Set olNS = Nothing
End Sub
See http://www.outlookcode.com/d/code/zaphtml.htm#ol2002 for another
example.
http://support.microsoft.com/?kbid06108A+ Oliv
*Oliv' que je salut a écrit *:
Fabrice tu peux sans doute utiliser la fonction de règle de message
"executer un script"
Le script doit comporter un argument MailItem (ou MeetingItem) et se
trouver soit dans thisoutlooksession soit dans un module
Sub RunAScriptRuleRoutine(MyMail As MailItem)
Dim strID As String
Dim olNS As Outlook.NameSpace
Dim msg As Outlook.MailItem
strID = MyMail.EntryID
Set olNS = Application.GetNamespace("MAPI")
Set msg = olNS.GetItemFromID(strID)
' do stuff with msg, e.g.
MsgBox msg.Body
Set msg = Nothing
Set olNS = Nothing
End Sub
See http://www.outlookcode.com/d/code/zaphtml.htm#ol2002 for another
example.
http://support.microsoft.com/?kbid06108A+ Oliv
*Oliv' <SUPPRIMERCECIcatteau@ricour-assurances.fr> que je salut a écrit *:
Fabrice tu peux sans doute utiliser la fonction de règle de message
"executer un script"
Le script doit comporter un argument MailItem (ou MeetingItem) et se
trouver soit dans thisoutlooksession soit dans un module
Sub RunAScriptRuleRoutine(MyMail As MailItem)
Dim strID As String
Dim olNS As Outlook.NameSpace
Dim msg As Outlook.MailItem
strID = MyMail.EntryID
Set olNS = Application.GetNamespace("MAPI")
Set msg = olNS.GetItemFromID(strID)
' do stuff with msg, e.g.
MsgBox msg.Body
Set msg = Nothing
Set olNS = Nothing
End Sub
See http://www.outlookcode.com/d/code/zaphtml.htm#ol2002 for another
example.
http://support.microsoft.com/?kbid06108
A+ Oliv
*Oliv' que je salut a écrit *:
Fabrice tu peux sans doute utiliser la fonction de règle de message
"executer un script"
Le script doit comporter un argument MailItem (ou MeetingItem) et se
trouver soit dans thisoutlooksession soit dans un module
Sub RunAScriptRuleRoutine(MyMail As MailItem)
Dim strID As String
Dim olNS As Outlook.NameSpace
Dim msg As Outlook.MailItem
strID = MyMail.EntryID
Set olNS = Application.GetNamespace("MAPI")
Set msg = olNS.GetItemFromID(strID)
' do stuff with msg, e.g.
MsgBox msg.Body
Set msg = Nothing
Set olNS = Nothing
End Sub
See http://www.outlookcode.com/d/code/zaphtml.htm#ol2002 for another
example.
http://support.microsoft.com/?kbid06108A+ Oliv
ça y est, j'ai pu pondre un petit bout de truc.
A voir plus bas...
J'ai attribué ce script à une règle qui l'exécute que pour les mails
contenant un mot que seule le serveur fax ajoute dans l'objet ( son
nom ), pour qu'il ne soit pas lancé pour tous les mails qui arrivent.
Par contre, j'ai 2 soucis :
Le premier, c'est qu'à chaque démarrage d'Outlook, à la première
application de la règle, j'ai le message d'activation des macros.
ça me fait chier, mais je ne veux pas baisser le niveau de sécurité au
minimum. Et je n'ai pas de certificat numérique à part ceux de mon
serveur qu'il faut redéclarer tous les an...
L'autre soucis un peu plus chiant, c'est qu'en suite, le script met
du temps à s'éxécuter.
C'est à dire que lorsque je reçois un mail vérifiant les critères, il
faut attendre entre 30 s et 1 min avant qu'il soit déplacé.
La règle semble marché normalement car lorsque les mails ne vérifient
pas le critère, les règles suivantes sont exécutées tout de suite.
D'autre part, si j'exécute la règle manuellement, le script déplace
bien le message instantanéement...
Une idée sur la cause de ce phénomène ?
Voici le code :
############################################################
Sub TrierLesFax(MonMail As MailItem)
Dim objPJ As Attachment, ObjetFichier As Object
Dim LigFic As String, FileID As Integer
Dim NumSDA As String
Dim DossierDest As Outlook.MAPIFolder
Dim Rep As String, Nb_PJ As Integer
' Définition du dossier de destination "Boîte aux lettres -
MoiSous-DossiersSous-Sous-Dossier"
On Error Resume Next
Set DossierDest > Application.GetNamespace("MAPI").Folders.Item("Boîte aux lettres -
Moi") Set DossierDest = DossierDest.Folders.Item("Sous-Dossiers")
Set DossierDest = DossierDest.Folders.Item("Sous-Sous-Dossier")
If Err <> 0 Then
MsgBox "Dossier de destination introuvable"
Exit Sub
End If
On Error GoTo 0
' Vérification du nb de PJ et sortie du script si il n'y en a pas
Nb_PJ = MonMail.Attachments.Count
If Nb_PJ = 0 Then Exit Sub
' Définition du répertoire temporaire et création si il n'existe
pas Rep = "c:temp"
If Rep <> "" Then
If Dir(Rep, vbDirectory) = "" Then
MkDir Rep
End If
End If
For Each objPJ In MonMail.Attachments
If Left(objPJ.FileName, 3) = "ATT" Then
objPJ.SaveAsFile Rep & objPJ.FileName
' Lecture du fichier à la recherche de la variable
X-LF-RoutingString
FileID = FreeFile
Open Rep & objPJ.FileName For Input As FileID
Do While Not EOF(FileID)
Line Input #FileID, LigFic
If Left(LigFic, 18) = "X-LF-RoutingString" Then
NumSDA = Right(LigFic, Len(LigFic) - 20)
End If
Loop
Close #1
' Suppression du fichier temporaire
Set ObjetFichier > CreateObject("Scripting.FileSystemObject")
ObjetFichier.deletefile Rep & objPJ.FileName, True Set
ObjetFichier = Nothing
End If
Next
If NumSDA = "111111111" Then MonMail.Move DossierDest
End Sub
############################################################
A+
"Oliv'" a écrit dans le
message de news: uH7ujoz$
*Oliv' que je salut a
écrit *: Fabrice tu peux sans doute utiliser la fonction de règle de
message
"executer un script"
Le script doit comporter un argument MailItem (ou MeetingItem) et se
trouver soit dans thisoutlooksession soit dans un module
Sub RunAScriptRuleRoutine(MyMail As MailItem)
Dim strID As String
Dim olNS As Outlook.NameSpace
Dim msg As Outlook.MailItem
strID = MyMail.EntryID
Set olNS = Application.GetNamespace("MAPI")
Set msg = olNS.GetItemFromID(strID)
' do stuff with msg, e.g.
MsgBox msg.Body
Set msg = Nothing
Set olNS = Nothing
End Sub
See http://www.outlookcode.com/d/code/zaphtml.htm#ol2002 for another
example.
http://support.microsoft.com/?kbid06108A+ Oliv
ça y est, j'ai pu pondre un petit bout de truc.
A voir plus bas...
J'ai attribué ce script à une règle qui l'exécute que pour les mails
contenant un mot que seule le serveur fax ajoute dans l'objet ( son
nom ), pour qu'il ne soit pas lancé pour tous les mails qui arrivent.
Par contre, j'ai 2 soucis :
Le premier, c'est qu'à chaque démarrage d'Outlook, à la première
application de la règle, j'ai le message d'activation des macros.
ça me fait chier, mais je ne veux pas baisser le niveau de sécurité au
minimum. Et je n'ai pas de certificat numérique à part ceux de mon
serveur qu'il faut redéclarer tous les an...
L'autre soucis un peu plus chiant, c'est qu'en suite, le script met
du temps à s'éxécuter.
C'est à dire que lorsque je reçois un mail vérifiant les critères, il
faut attendre entre 30 s et 1 min avant qu'il soit déplacé.
La règle semble marché normalement car lorsque les mails ne vérifient
pas le critère, les règles suivantes sont exécutées tout de suite.
D'autre part, si j'exécute la règle manuellement, le script déplace
bien le message instantanéement...
Une idée sur la cause de ce phénomène ?
Voici le code :
############################################################
Sub TrierLesFax(MonMail As MailItem)
Dim objPJ As Attachment, ObjetFichier As Object
Dim LigFic As String, FileID As Integer
Dim NumSDA As String
Dim DossierDest As Outlook.MAPIFolder
Dim Rep As String, Nb_PJ As Integer
' Définition du dossier de destination "Boîte aux lettres -
MoiSous-DossiersSous-Sous-Dossier"
On Error Resume Next
Set DossierDest > Application.GetNamespace("MAPI").Folders.Item("Boîte aux lettres -
Moi") Set DossierDest = DossierDest.Folders.Item("Sous-Dossiers")
Set DossierDest = DossierDest.Folders.Item("Sous-Sous-Dossier")
If Err <> 0 Then
MsgBox "Dossier de destination introuvable"
Exit Sub
End If
On Error GoTo 0
' Vérification du nb de PJ et sortie du script si il n'y en a pas
Nb_PJ = MonMail.Attachments.Count
If Nb_PJ = 0 Then Exit Sub
' Définition du répertoire temporaire et création si il n'existe
pas Rep = "c:temp"
If Rep <> "" Then
If Dir(Rep, vbDirectory) = "" Then
MkDir Rep
End If
End If
For Each objPJ In MonMail.Attachments
If Left(objPJ.FileName, 3) = "ATT" Then
objPJ.SaveAsFile Rep & objPJ.FileName
' Lecture du fichier à la recherche de la variable
X-LF-RoutingString
FileID = FreeFile
Open Rep & objPJ.FileName For Input As FileID
Do While Not EOF(FileID)
Line Input #FileID, LigFic
If Left(LigFic, 18) = "X-LF-RoutingString" Then
NumSDA = Right(LigFic, Len(LigFic) - 20)
End If
Loop
Close #1
' Suppression du fichier temporaire
Set ObjetFichier > CreateObject("Scripting.FileSystemObject")
ObjetFichier.deletefile Rep & objPJ.FileName, True Set
ObjetFichier = Nothing
End If
Next
If NumSDA = "111111111" Then MonMail.Move DossierDest
End Sub
############################################################
A+
"Oliv'" <SUPPRIMERCECIcatteau@ricour-assurances.fr> a écrit dans le
message de news: uH7ujoz$GHA.3604@TK2MSFTNGP04.phx.gbl...
*Oliv' <SUPPRIMERCECIcatteau@ricour-assurances.fr> que je salut a
écrit *: Fabrice tu peux sans doute utiliser la fonction de règle de
message
"executer un script"
Le script doit comporter un argument MailItem (ou MeetingItem) et se
trouver soit dans thisoutlooksession soit dans un module
Sub RunAScriptRuleRoutine(MyMail As MailItem)
Dim strID As String
Dim olNS As Outlook.NameSpace
Dim msg As Outlook.MailItem
strID = MyMail.EntryID
Set olNS = Application.GetNamespace("MAPI")
Set msg = olNS.GetItemFromID(strID)
' do stuff with msg, e.g.
MsgBox msg.Body
Set msg = Nothing
Set olNS = Nothing
End Sub
See http://www.outlookcode.com/d/code/zaphtml.htm#ol2002 for another
example.
http://support.microsoft.com/?kbid06108
A+ Oliv
ça y est, j'ai pu pondre un petit bout de truc.
A voir plus bas...
J'ai attribué ce script à une règle qui l'exécute que pour les mails
contenant un mot que seule le serveur fax ajoute dans l'objet ( son
nom ), pour qu'il ne soit pas lancé pour tous les mails qui arrivent.
Par contre, j'ai 2 soucis :
Le premier, c'est qu'à chaque démarrage d'Outlook, à la première
application de la règle, j'ai le message d'activation des macros.
ça me fait chier, mais je ne veux pas baisser le niveau de sécurité au
minimum. Et je n'ai pas de certificat numérique à part ceux de mon
serveur qu'il faut redéclarer tous les an...
L'autre soucis un peu plus chiant, c'est qu'en suite, le script met
du temps à s'éxécuter.
C'est à dire que lorsque je reçois un mail vérifiant les critères, il
faut attendre entre 30 s et 1 min avant qu'il soit déplacé.
La règle semble marché normalement car lorsque les mails ne vérifient
pas le critère, les règles suivantes sont exécutées tout de suite.
D'autre part, si j'exécute la règle manuellement, le script déplace
bien le message instantanéement...
Une idée sur la cause de ce phénomène ?
Voici le code :
############################################################
Sub TrierLesFax(MonMail As MailItem)
Dim objPJ As Attachment, ObjetFichier As Object
Dim LigFic As String, FileID As Integer
Dim NumSDA As String
Dim DossierDest As Outlook.MAPIFolder
Dim Rep As String, Nb_PJ As Integer
' Définition du dossier de destination "Boîte aux lettres -
MoiSous-DossiersSous-Sous-Dossier"
On Error Resume Next
Set DossierDest > Application.GetNamespace("MAPI").Folders.Item("Boîte aux lettres -
Moi") Set DossierDest = DossierDest.Folders.Item("Sous-Dossiers")
Set DossierDest = DossierDest.Folders.Item("Sous-Sous-Dossier")
If Err <> 0 Then
MsgBox "Dossier de destination introuvable"
Exit Sub
End If
On Error GoTo 0
' Vérification du nb de PJ et sortie du script si il n'y en a pas
Nb_PJ = MonMail.Attachments.Count
If Nb_PJ = 0 Then Exit Sub
' Définition du répertoire temporaire et création si il n'existe
pas Rep = "c:temp"
If Rep <> "" Then
If Dir(Rep, vbDirectory) = "" Then
MkDir Rep
End If
End If
For Each objPJ In MonMail.Attachments
If Left(objPJ.FileName, 3) = "ATT" Then
objPJ.SaveAsFile Rep & objPJ.FileName
' Lecture du fichier à la recherche de la variable
X-LF-RoutingString
FileID = FreeFile
Open Rep & objPJ.FileName For Input As FileID
Do While Not EOF(FileID)
Line Input #FileID, LigFic
If Left(LigFic, 18) = "X-LF-RoutingString" Then
NumSDA = Right(LigFic, Len(LigFic) - 20)
End If
Loop
Close #1
' Suppression du fichier temporaire
Set ObjetFichier > CreateObject("Scripting.FileSystemObject")
ObjetFichier.deletefile Rep & objPJ.FileName, True Set
ObjetFichier = Nothing
End If
Next
If NumSDA = "111111111" Then MonMail.Move DossierDest
End Sub
############################################################
A+
"Oliv'" a écrit dans le
message de news: uH7ujoz$
*Oliv' que je salut a
écrit *: Fabrice tu peux sans doute utiliser la fonction de règle de
message
"executer un script"
Le script doit comporter un argument MailItem (ou MeetingItem) et se
trouver soit dans thisoutlooksession soit dans un module
Sub RunAScriptRuleRoutine(MyMail As MailItem)
Dim strID As String
Dim olNS As Outlook.NameSpace
Dim msg As Outlook.MailItem
strID = MyMail.EntryID
Set olNS = Application.GetNamespace("MAPI")
Set msg = olNS.GetItemFromID(strID)
' do stuff with msg, e.g.
MsgBox msg.Body
Set msg = Nothing
Set olNS = Nothing
End Sub
See http://www.outlookcode.com/d/code/zaphtml.htm#ol2002 for another
example.
http://support.microsoft.com/?kbid06108A+ Oliv
Parfait
il faut en créer un avec SELFCERT ("certificat numérique pour les projets
VBA" dans démarrrer / MO/ outils microsoft office)
et l'ajouter à ton projet. (VBE /outils /signature électronique)
Pour les autres utilisateurs il faut afficher le détail du certificat et
l'installer puis à la réouverture on peu cocher la case qui mémorise la
confiance
j'ai pas testé mais ca à l'air bien , ajoute un msgbox à la fin pour voir
son fonctionnement.
Parfait
il faut en créer un avec SELFCERT ("certificat numérique pour les projets
VBA" dans démarrrer / MO/ outils microsoft office)
et l'ajouter à ton projet. (VBE /outils /signature électronique)
Pour les autres utilisateurs il faut afficher le détail du certificat et
l'installer puis à la réouverture on peu cocher la case qui mémorise la
confiance
j'ai pas testé mais ca à l'air bien , ajoute un msgbox à la fin pour voir
son fonctionnement.
Parfait
il faut en créer un avec SELFCERT ("certificat numérique pour les projets
VBA" dans démarrrer / MO/ outils microsoft office)
et l'ajouter à ton projet. (VBE /outils /signature électronique)
Pour les autres utilisateurs il faut afficher le détail du certificat et
l'installer puis à la réouverture on peu cocher la case qui mémorise la
confiance
j'ai pas testé mais ca à l'air bien , ajoute un msgbox à la fin pour voir
son fonctionnement.
c'est ce que j'ai fait, et c'est ce qui m'a permis de me rendre
compte que le script mettait du temps à s'exécuter...
Je n'ai toujours pas compris pourquoi puisque lorsque je lance la
règle manuellement, l'exécution est instantanée...
dur dur ... !!!!
c'est ce que j'ai fait, et c'est ce qui m'a permis de me rendre
compte que le script mettait du temps à s'exécuter...
Je n'ai toujours pas compris pourquoi puisque lorsque je lance la
règle manuellement, l'exécution est instantanée...
dur dur ... !!!!
c'est ce que j'ai fait, et c'est ce qui m'a permis de me rendre
compte que le script mettait du temps à s'exécuter...
Je n'ai toujours pas compris pourquoi puisque lorsque je lance la
règle manuellement, l'exécution est instantanée...
dur dur ... !!!!
*Fabrice N." <"f.nebbia" dans le domaine "technicn.com <"f.nebbia" dans le
domaine "technicn.com"> que je salut a écrit *:c'est ce que j'ai fait, et c'est ce qui m'a permis de me rendre
compte que le script mettait du temps à s'exécuter...
Je n'ai toujours pas compris pourquoi puisque lorsque je lance la
règle manuellement, l'exécution est instantanée...
dur dur ... !!!!
Le fait de redéfinir ta variable DossierDest à plusieurs reprises est
peut être la cause.
Chez moi le code ci-dessous (un peu modifié)est instantané, également en
mode mis en cache.
Sub TrierLesFax(MonMail As MailItem)
Dim objPJ As Attachment, ObjetFichier As Object
Dim LigFic As String, FileID As Integer
Dim NumSDA As String
Dim DossierDest As Outlook.MAPIFolder
Dim Rep As String, Nb_PJ As Integer
' Définition du dossier de destination "Boîte aux
lettres -MoiSous-DossiersSous-Sous-Dossier"
On Error Resume Next
Dim myolApp As Outlook.Application
Dim myNamespace As Outlook.NameSpace
Set myolApp = CreateObject("Outlook.Application")
Set myNamespace = myolApp.GetNamespace("MAPI")
Set myolApp.ActiveExplorer.CurrentFolder = _
myNamespace.GetDefaultFolder(olFolderInbox)
Set DossierDest =
myolApp.ActiveExplorer.CurrentFolder.Folders.Item("Sous-Dossiers")
'Set DossierDest = DossierDest.Folders.Item("Sous-Sous-Dossier")
If Err <> 0 Then
MsgBox "Dossier de destination introuvable"
Exit Sub
End If
On Error GoTo 0
' Vérification du nb de PJ et sortie du script si il n'y en a pas
Nb_PJ = MonMail.Attachments.Count
' If Nb_PJ = 0 Then Exit Sub
'
' ' Définition du répertoire temporaire et création si il n'existe pas
' Rep = "c:temp"
' If Rep <> "" Then
' If Dir(Rep, vbDirectory) = "" Then
' MkDir Rep
' End If
' End If
'
' For Each objPJ In MonMail.Attachments
'
' If Left(objPJ.FileName, 3) = "ATT" Then
' objPJ.SaveAsFile Rep & objPJ.FileName
'
' ' Lecture du fichier à la recherche de la variable x -LF -
RoutingString
' FileID = FreeFile
' Open Rep & objPJ.FileName For Input As FileID
' Do While Not EOF(FileID)
' Line Input #FileID, LigFic
' If Left(LigFic, 18) = "X-LF-RoutingString" Then
' NumSDA = Right(LigFic, Len(LigFic) - 20)
' End If
' Loop
' Close #1
'
' ' Suppression du fichier temporaire
' Set ObjetFichier = CreateObject("Scripting.FileSystemObject")
' ObjetFichier.DeleteFile Rep & objPJ.FileName, True
' Set ObjetFichier = Nothing
'
' End If
'
' Next
NumSDA = "111111111"
If NumSDA = "111111111" Then MonMail.Move DossierDest
End Sub
*Fabrice N." <"f.nebbia" dans le domaine "technicn.com <"f.nebbia" dans le
domaine "technicn.com"> que je salut a écrit *:
c'est ce que j'ai fait, et c'est ce qui m'a permis de me rendre
compte que le script mettait du temps à s'exécuter...
Je n'ai toujours pas compris pourquoi puisque lorsque je lance la
règle manuellement, l'exécution est instantanée...
dur dur ... !!!!
Le fait de redéfinir ta variable DossierDest à plusieurs reprises est
peut être la cause.
Chez moi le code ci-dessous (un peu modifié)est instantané, également en
mode mis en cache.
Sub TrierLesFax(MonMail As MailItem)
Dim objPJ As Attachment, ObjetFichier As Object
Dim LigFic As String, FileID As Integer
Dim NumSDA As String
Dim DossierDest As Outlook.MAPIFolder
Dim Rep As String, Nb_PJ As Integer
' Définition du dossier de destination "Boîte aux
lettres -MoiSous-DossiersSous-Sous-Dossier"
On Error Resume Next
Dim myolApp As Outlook.Application
Dim myNamespace As Outlook.NameSpace
Set myolApp = CreateObject("Outlook.Application")
Set myNamespace = myolApp.GetNamespace("MAPI")
Set myolApp.ActiveExplorer.CurrentFolder = _
myNamespace.GetDefaultFolder(olFolderInbox)
Set DossierDest =
myolApp.ActiveExplorer.CurrentFolder.Folders.Item("Sous-Dossiers")
'Set DossierDest = DossierDest.Folders.Item("Sous-Sous-Dossier")
If Err <> 0 Then
MsgBox "Dossier de destination introuvable"
Exit Sub
End If
On Error GoTo 0
' Vérification du nb de PJ et sortie du script si il n'y en a pas
Nb_PJ = MonMail.Attachments.Count
' If Nb_PJ = 0 Then Exit Sub
'
' ' Définition du répertoire temporaire et création si il n'existe pas
' Rep = "c:temp"
' If Rep <> "" Then
' If Dir(Rep, vbDirectory) = "" Then
' MkDir Rep
' End If
' End If
'
' For Each objPJ In MonMail.Attachments
'
' If Left(objPJ.FileName, 3) = "ATT" Then
' objPJ.SaveAsFile Rep & objPJ.FileName
'
' ' Lecture du fichier à la recherche de la variable x -LF -
RoutingString
' FileID = FreeFile
' Open Rep & objPJ.FileName For Input As FileID
' Do While Not EOF(FileID)
' Line Input #FileID, LigFic
' If Left(LigFic, 18) = "X-LF-RoutingString" Then
' NumSDA = Right(LigFic, Len(LigFic) - 20)
' End If
' Loop
' Close #1
'
' ' Suppression du fichier temporaire
' Set ObjetFichier = CreateObject("Scripting.FileSystemObject")
' ObjetFichier.DeleteFile Rep & objPJ.FileName, True
' Set ObjetFichier = Nothing
'
' End If
'
' Next
NumSDA = "111111111"
If NumSDA = "111111111" Then MonMail.Move DossierDest
End Sub
*Fabrice N." <"f.nebbia" dans le domaine "technicn.com <"f.nebbia" dans le
domaine "technicn.com"> que je salut a écrit *:c'est ce que j'ai fait, et c'est ce qui m'a permis de me rendre
compte que le script mettait du temps à s'exécuter...
Je n'ai toujours pas compris pourquoi puisque lorsque je lance la
règle manuellement, l'exécution est instantanée...
dur dur ... !!!!
Le fait de redéfinir ta variable DossierDest à plusieurs reprises est
peut être la cause.
Chez moi le code ci-dessous (un peu modifié)est instantané, également en
mode mis en cache.
Sub TrierLesFax(MonMail As MailItem)
Dim objPJ As Attachment, ObjetFichier As Object
Dim LigFic As String, FileID As Integer
Dim NumSDA As String
Dim DossierDest As Outlook.MAPIFolder
Dim Rep As String, Nb_PJ As Integer
' Définition du dossier de destination "Boîte aux
lettres -MoiSous-DossiersSous-Sous-Dossier"
On Error Resume Next
Dim myolApp As Outlook.Application
Dim myNamespace As Outlook.NameSpace
Set myolApp = CreateObject("Outlook.Application")
Set myNamespace = myolApp.GetNamespace("MAPI")
Set myolApp.ActiveExplorer.CurrentFolder = _
myNamespace.GetDefaultFolder(olFolderInbox)
Set DossierDest =
myolApp.ActiveExplorer.CurrentFolder.Folders.Item("Sous-Dossiers")
'Set DossierDest = DossierDest.Folders.Item("Sous-Sous-Dossier")
If Err <> 0 Then
MsgBox "Dossier de destination introuvable"
Exit Sub
End If
On Error GoTo 0
' Vérification du nb de PJ et sortie du script si il n'y en a pas
Nb_PJ = MonMail.Attachments.Count
' If Nb_PJ = 0 Then Exit Sub
'
' ' Définition du répertoire temporaire et création si il n'existe pas
' Rep = "c:temp"
' If Rep <> "" Then
' If Dir(Rep, vbDirectory) = "" Then
' MkDir Rep
' End If
' End If
'
' For Each objPJ In MonMail.Attachments
'
' If Left(objPJ.FileName, 3) = "ATT" Then
' objPJ.SaveAsFile Rep & objPJ.FileName
'
' ' Lecture du fichier à la recherche de la variable x -LF -
RoutingString
' FileID = FreeFile
' Open Rep & objPJ.FileName For Input As FileID
' Do While Not EOF(FileID)
' Line Input #FileID, LigFic
' If Left(LigFic, 18) = "X-LF-RoutingString" Then
' NumSDA = Right(LigFic, Len(LigFic) - 20)
' End If
' Loop
' Close #1
'
' ' Suppression du fichier temporaire
' Set ObjetFichier = CreateObject("Scripting.FileSystemObject")
' ObjetFichier.DeleteFile Rep & objPJ.FileName, True
' Set ObjetFichier = Nothing
'
' End If
'
' Next
NumSDA = "111111111"
If NumSDA = "111111111" Then MonMail.Move DossierDest
End Sub
Salut Oliv'
J'ai testé avec ta macro, j'ai le même résultat.
Plus de 30 s avant exécution du code. En plus, il ne me trouve pas le
dossier "Sous-Dossiers"
...
Je sais pas si c'est lié, mais depuis mon passage à Outlook 2003, j'ai
toujours remarqué un petit délai dans la reception de mes mails.
Quand j'envoie un mail, il faut que je change de dossier pour qu'il
disparaissent de la boîte d'envoi.
Pour la réception, c'est pareil, si je ne me déplace pas dans les
dossiers, je ne vois pas les nouveau messages...
Par contre, même une fois les messages arrivé, ma macros met un
certain temps à se lancer...
Et c'est pas une des instructions de la macro qui bloque car j'ai mis
un msgbox au tout début et il met un moment à apparaître aussi...
C'est à rien y comprendre...
"Oliv'" a écrit dans le
message de news:
*Fabrice N." <"f.nebbia" dans le domaine "technicn.com <"f.nebbia"
dans le domaine "technicn.com"> que je salut a écrit *:c'est ce que j'ai fait, et c'est ce qui m'a permis de me rendre
compte que le script mettait du temps à s'exécuter...
Je n'ai toujours pas compris pourquoi puisque lorsque je lance la
règle manuellement, l'exécution est instantanée...
dur dur ... !!!!
Le fait de redéfinir ta variable DossierDest à plusieurs reprises
est peut être la cause.
Chez moi le code ci-dessous (un peu modifié)est instantané,
également en mode mis en cache.
Sub TrierLesFax(MonMail As MailItem)
Dim objPJ As Attachment, ObjetFichier As Object
Dim LigFic As String, FileID As Integer
Dim NumSDA As String
Dim DossierDest As Outlook.MAPIFolder
Dim Rep As String, Nb_PJ As Integer
' Définition du dossier de destination "Boîte aux
lettres -MoiSous-DossiersSous-Sous-Dossier"
On Error Resume Next
Dim myolApp As Outlook.Application
Dim myNamespace As Outlook.NameSpace
Set myolApp = CreateObject("Outlook.Application")
Set myNamespace = myolApp.GetNamespace("MAPI")
Set myolApp.ActiveExplorer.CurrentFolder = _
myNamespace.GetDefaultFolder(olFolderInbox)
Set DossierDest >> myolApp.ActiveExplorer.CurrentFolder.Folders.Item("Sous-Dossiers")
'Set DossierDest = DossierDest.Folders.Item("Sous-Sous-Dossier")
If Err <> 0 Then
MsgBox "Dossier de destination introuvable"
Exit Sub
End If
On Error GoTo 0
' Vérification du nb de PJ et sortie du script si il n'y en a pas
Nb_PJ = MonMail.Attachments.Count
' If Nb_PJ = 0 Then Exit Sub
'
' ' Définition du répertoire temporaire et création si il
n'existe pas ' Rep = "c:temp"
' If Rep <> "" Then
' If Dir(Rep, vbDirectory) = "" Then
' MkDir Rep
' End If
' End If
'
' For Each objPJ In MonMail.Attachments
'
' If Left(objPJ.FileName, 3) = "ATT" Then
' objPJ.SaveAsFile Rep & objPJ.FileName
'
' ' Lecture du fichier à la recherche de la variable x
-LF - RoutingString
' FileID = FreeFile
' Open Rep & objPJ.FileName For Input As FileID
' Do While Not EOF(FileID)
' Line Input #FileID, LigFic
' If Left(LigFic, 18) = "X-LF-RoutingString" Then
' NumSDA = Right(LigFic, Len(LigFic) - 20)
' End If
' Loop
' Close #1
'
' ' Suppression du fichier temporaire
' Set ObjetFichier >> CreateObject("Scripting.FileSystemObject") '
ObjetFichier.DeleteFile Rep & objPJ.FileName, True ' Set
ObjetFichier = Nothing '
' End If
'
' Next
NumSDA = "111111111"
If NumSDA = "111111111" Then MonMail.Move DossierDest
End Sub
Salut Oliv'
J'ai testé avec ta macro, j'ai le même résultat.
Plus de 30 s avant exécution du code. En plus, il ne me trouve pas le
dossier "Sous-Dossiers"
...
Je sais pas si c'est lié, mais depuis mon passage à Outlook 2003, j'ai
toujours remarqué un petit délai dans la reception de mes mails.
Quand j'envoie un mail, il faut que je change de dossier pour qu'il
disparaissent de la boîte d'envoi.
Pour la réception, c'est pareil, si je ne me déplace pas dans les
dossiers, je ne vois pas les nouveau messages...
Par contre, même une fois les messages arrivé, ma macros met un
certain temps à se lancer...
Et c'est pas une des instructions de la macro qui bloque car j'ai mis
un msgbox au tout début et il met un moment à apparaître aussi...
C'est à rien y comprendre...
"Oliv'" <SUPPRIMERCECIcatteau@ricour-assurances.fr> a écrit dans le
message de news: eaux5CcAHHA.3316@TK2MSFTNGP02.phx.gbl...
*Fabrice N." <"f.nebbia" dans le domaine "technicn.com <"f.nebbia"
dans le domaine "technicn.com"> que je salut a écrit *:
c'est ce que j'ai fait, et c'est ce qui m'a permis de me rendre
compte que le script mettait du temps à s'exécuter...
Je n'ai toujours pas compris pourquoi puisque lorsque je lance la
règle manuellement, l'exécution est instantanée...
dur dur ... !!!!
Le fait de redéfinir ta variable DossierDest à plusieurs reprises
est peut être la cause.
Chez moi le code ci-dessous (un peu modifié)est instantané,
également en mode mis en cache.
Sub TrierLesFax(MonMail As MailItem)
Dim objPJ As Attachment, ObjetFichier As Object
Dim LigFic As String, FileID As Integer
Dim NumSDA As String
Dim DossierDest As Outlook.MAPIFolder
Dim Rep As String, Nb_PJ As Integer
' Définition du dossier de destination "Boîte aux
lettres -MoiSous-DossiersSous-Sous-Dossier"
On Error Resume Next
Dim myolApp As Outlook.Application
Dim myNamespace As Outlook.NameSpace
Set myolApp = CreateObject("Outlook.Application")
Set myNamespace = myolApp.GetNamespace("MAPI")
Set myolApp.ActiveExplorer.CurrentFolder = _
myNamespace.GetDefaultFolder(olFolderInbox)
Set DossierDest >> myolApp.ActiveExplorer.CurrentFolder.Folders.Item("Sous-Dossiers")
'Set DossierDest = DossierDest.Folders.Item("Sous-Sous-Dossier")
If Err <> 0 Then
MsgBox "Dossier de destination introuvable"
Exit Sub
End If
On Error GoTo 0
' Vérification du nb de PJ et sortie du script si il n'y en a pas
Nb_PJ = MonMail.Attachments.Count
' If Nb_PJ = 0 Then Exit Sub
'
' ' Définition du répertoire temporaire et création si il
n'existe pas ' Rep = "c:temp"
' If Rep <> "" Then
' If Dir(Rep, vbDirectory) = "" Then
' MkDir Rep
' End If
' End If
'
' For Each objPJ In MonMail.Attachments
'
' If Left(objPJ.FileName, 3) = "ATT" Then
' objPJ.SaveAsFile Rep & objPJ.FileName
'
' ' Lecture du fichier à la recherche de la variable x
-LF - RoutingString
' FileID = FreeFile
' Open Rep & objPJ.FileName For Input As FileID
' Do While Not EOF(FileID)
' Line Input #FileID, LigFic
' If Left(LigFic, 18) = "X-LF-RoutingString" Then
' NumSDA = Right(LigFic, Len(LigFic) - 20)
' End If
' Loop
' Close #1
'
' ' Suppression du fichier temporaire
' Set ObjetFichier >> CreateObject("Scripting.FileSystemObject") '
ObjetFichier.DeleteFile Rep & objPJ.FileName, True ' Set
ObjetFichier = Nothing '
' End If
'
' Next
NumSDA = "111111111"
If NumSDA = "111111111" Then MonMail.Move DossierDest
End Sub
Salut Oliv'
J'ai testé avec ta macro, j'ai le même résultat.
Plus de 30 s avant exécution du code. En plus, il ne me trouve pas le
dossier "Sous-Dossiers"
...
Je sais pas si c'est lié, mais depuis mon passage à Outlook 2003, j'ai
toujours remarqué un petit délai dans la reception de mes mails.
Quand j'envoie un mail, il faut que je change de dossier pour qu'il
disparaissent de la boîte d'envoi.
Pour la réception, c'est pareil, si je ne me déplace pas dans les
dossiers, je ne vois pas les nouveau messages...
Par contre, même une fois les messages arrivé, ma macros met un
certain temps à se lancer...
Et c'est pas une des instructions de la macro qui bloque car j'ai mis
un msgbox au tout début et il met un moment à apparaître aussi...
C'est à rien y comprendre...
"Oliv'" a écrit dans le
message de news:
*Fabrice N." <"f.nebbia" dans le domaine "technicn.com <"f.nebbia"
dans le domaine "technicn.com"> que je salut a écrit *:c'est ce que j'ai fait, et c'est ce qui m'a permis de me rendre
compte que le script mettait du temps à s'exécuter...
Je n'ai toujours pas compris pourquoi puisque lorsque je lance la
règle manuellement, l'exécution est instantanée...
dur dur ... !!!!
Le fait de redéfinir ta variable DossierDest à plusieurs reprises
est peut être la cause.
Chez moi le code ci-dessous (un peu modifié)est instantané,
également en mode mis en cache.
Sub TrierLesFax(MonMail As MailItem)
Dim objPJ As Attachment, ObjetFichier As Object
Dim LigFic As String, FileID As Integer
Dim NumSDA As String
Dim DossierDest As Outlook.MAPIFolder
Dim Rep As String, Nb_PJ As Integer
' Définition du dossier de destination "Boîte aux
lettres -MoiSous-DossiersSous-Sous-Dossier"
On Error Resume Next
Dim myolApp As Outlook.Application
Dim myNamespace As Outlook.NameSpace
Set myolApp = CreateObject("Outlook.Application")
Set myNamespace = myolApp.GetNamespace("MAPI")
Set myolApp.ActiveExplorer.CurrentFolder = _
myNamespace.GetDefaultFolder(olFolderInbox)
Set DossierDest >> myolApp.ActiveExplorer.CurrentFolder.Folders.Item("Sous-Dossiers")
'Set DossierDest = DossierDest.Folders.Item("Sous-Sous-Dossier")
If Err <> 0 Then
MsgBox "Dossier de destination introuvable"
Exit Sub
End If
On Error GoTo 0
' Vérification du nb de PJ et sortie du script si il n'y en a pas
Nb_PJ = MonMail.Attachments.Count
' If Nb_PJ = 0 Then Exit Sub
'
' ' Définition du répertoire temporaire et création si il
n'existe pas ' Rep = "c:temp"
' If Rep <> "" Then
' If Dir(Rep, vbDirectory) = "" Then
' MkDir Rep
' End If
' End If
'
' For Each objPJ In MonMail.Attachments
'
' If Left(objPJ.FileName, 3) = "ATT" Then
' objPJ.SaveAsFile Rep & objPJ.FileName
'
' ' Lecture du fichier à la recherche de la variable x
-LF - RoutingString
' FileID = FreeFile
' Open Rep & objPJ.FileName For Input As FileID
' Do While Not EOF(FileID)
' Line Input #FileID, LigFic
' If Left(LigFic, 18) = "X-LF-RoutingString" Then
' NumSDA = Right(LigFic, Len(LigFic) - 20)
' End If
' Loop
' Close #1
'
' ' Suppression du fichier temporaire
' Set ObjetFichier >> CreateObject("Scripting.FileSystemObject") '
ObjetFichier.DeleteFile Rep & objPJ.FileName, True ' Set
ObjetFichier = Nothing '
' End If
'
' Next
NumSDA = "111111111"
If NumSDA = "111111111" Then MonMail.Move DossierDest
End Sub
*Fabrice N." <"f.nebbia" dans le domaine "technicn.com <"f.nebbia" dans le
domaine "technicn.com"> que je salut a écrit *:Salut Oliv'
J'ai testé avec ta macro, j'ai le même résultat.
Plus de 30 s avant exécution du code. En plus, il ne me trouve pas le
dossier "Sous-Dossiers"
...
Je sais pas si c'est lié, mais depuis mon passage à Outlook 2003, j'ai
toujours remarqué un petit délai dans la reception de mes mails.
Quand j'envoie un mail, il faut que je change de dossier pour qu'il
disparaissent de la boîte d'envoi.
Pour la réception, c'est pareil, si je ne me déplace pas dans les
dossiers, je ne vois pas les nouveau messages...
Par contre, même une fois les messages arrivé, ma macros met un
certain temps à se lancer...
Et c'est pas une des instructions de la macro qui bloque car j'ai mis
un msgbox au tout début et il met un moment à apparaître aussi...
C'est à rien y comprendre...
tu es en pst ou exchange ?
Essaye en créant un profil test
"Oliv'" a écrit dans le
message de news:
*Fabrice N." <"f.nebbia" dans le domaine "technicn.com <"f.nebbia"
dans le domaine "technicn.com"> que je salut a écrit *:c'est ce que j'ai fait, et c'est ce qui m'a permis de me rendre
compte que le script mettait du temps à s'exécuter...
Je n'ai toujours pas compris pourquoi puisque lorsque je lance la
règle manuellement, l'exécution est instantanée...
dur dur ... !!!!
Le fait de redéfinir ta variable DossierDest à plusieurs reprises
est peut être la cause.
Chez moi le code ci-dessous (un peu modifié)est instantané,
également en mode mis en cache.
Sub TrierLesFax(MonMail As MailItem)
Dim objPJ As Attachment, ObjetFichier As Object
Dim LigFic As String, FileID As Integer
Dim NumSDA As String
Dim DossierDest As Outlook.MAPIFolder
Dim Rep As String, Nb_PJ As Integer
' Définition du dossier de destination "Boîte aux
lettres -MoiSous-DossiersSous-Sous-Dossier"
On Error Resume Next
Dim myolApp As Outlook.Application
Dim myNamespace As Outlook.NameSpace
Set myolApp = CreateObject("Outlook.Application")
Set myNamespace = myolApp.GetNamespace("MAPI")
Set myolApp.ActiveExplorer.CurrentFolder = _
myNamespace.GetDefaultFolder(olFolderInbox)
Set DossierDest >>> myolApp.ActiveExplorer.CurrentFolder.Folders.Item("Sous-Dossiers")
'Set DossierDest = DossierDest.Folders.Item("Sous-Sous-Dossier")
If Err <> 0 Then
MsgBox "Dossier de destination introuvable"
Exit Sub
End If
On Error GoTo 0
' Vérification du nb de PJ et sortie du script si il n'y en a pas
Nb_PJ = MonMail.Attachments.Count
' If Nb_PJ = 0 Then Exit Sub
'
' ' Définition du répertoire temporaire et création si il
n'existe pas ' Rep = "c:temp"
' If Rep <> "" Then
' If Dir(Rep, vbDirectory) = "" Then
' MkDir Rep
' End If
' End If
'
' For Each objPJ In MonMail.Attachments
'
' If Left(objPJ.FileName, 3) = "ATT" Then
' objPJ.SaveAsFile Rep & objPJ.FileName
'
' ' Lecture du fichier à la recherche de la variable x
-LF - RoutingString
' FileID = FreeFile
' Open Rep & objPJ.FileName For Input As FileID
' Do While Not EOF(FileID)
' Line Input #FileID, LigFic
' If Left(LigFic, 18) = "X-LF-RoutingString" Then
' NumSDA = Right(LigFic, Len(LigFic) - 20)
' End If
' Loop
' Close #1
'
' ' Suppression du fichier temporaire
' Set ObjetFichier >>> CreateObject("Scripting.FileSystemObject") ' ObjetFichier.DeleteFile Rep
& objPJ.FileName, True ' Set
ObjetFichier = Nothing '
' End If
'
' Next
NumSDA = "111111111"
If NumSDA = "111111111" Then MonMail.Move DossierDest
End Sub
*Fabrice N." <"f.nebbia" dans le domaine "technicn.com <"f.nebbia" dans le
domaine "technicn.com"> que je salut a écrit *:
Salut Oliv'
J'ai testé avec ta macro, j'ai le même résultat.
Plus de 30 s avant exécution du code. En plus, il ne me trouve pas le
dossier "Sous-Dossiers"
...
Je sais pas si c'est lié, mais depuis mon passage à Outlook 2003, j'ai
toujours remarqué un petit délai dans la reception de mes mails.
Quand j'envoie un mail, il faut que je change de dossier pour qu'il
disparaissent de la boîte d'envoi.
Pour la réception, c'est pareil, si je ne me déplace pas dans les
dossiers, je ne vois pas les nouveau messages...
Par contre, même une fois les messages arrivé, ma macros met un
certain temps à se lancer...
Et c'est pas une des instructions de la macro qui bloque car j'ai mis
un msgbox au tout début et il met un moment à apparaître aussi...
C'est à rien y comprendre...
tu es en pst ou exchange ?
Essaye en créant un profil test
"Oliv'" <SUPPRIMERCECIcatteau@ricour-assurances.fr> a écrit dans le
message de news: eaux5CcAHHA.3316@TK2MSFTNGP02.phx.gbl...
*Fabrice N." <"f.nebbia" dans le domaine "technicn.com <"f.nebbia"
dans le domaine "technicn.com"> que je salut a écrit *:
c'est ce que j'ai fait, et c'est ce qui m'a permis de me rendre
compte que le script mettait du temps à s'exécuter...
Je n'ai toujours pas compris pourquoi puisque lorsque je lance la
règle manuellement, l'exécution est instantanée...
dur dur ... !!!!
Le fait de redéfinir ta variable DossierDest à plusieurs reprises
est peut être la cause.
Chez moi le code ci-dessous (un peu modifié)est instantané,
également en mode mis en cache.
Sub TrierLesFax(MonMail As MailItem)
Dim objPJ As Attachment, ObjetFichier As Object
Dim LigFic As String, FileID As Integer
Dim NumSDA As String
Dim DossierDest As Outlook.MAPIFolder
Dim Rep As String, Nb_PJ As Integer
' Définition du dossier de destination "Boîte aux
lettres -MoiSous-DossiersSous-Sous-Dossier"
On Error Resume Next
Dim myolApp As Outlook.Application
Dim myNamespace As Outlook.NameSpace
Set myolApp = CreateObject("Outlook.Application")
Set myNamespace = myolApp.GetNamespace("MAPI")
Set myolApp.ActiveExplorer.CurrentFolder = _
myNamespace.GetDefaultFolder(olFolderInbox)
Set DossierDest >>> myolApp.ActiveExplorer.CurrentFolder.Folders.Item("Sous-Dossiers")
'Set DossierDest = DossierDest.Folders.Item("Sous-Sous-Dossier")
If Err <> 0 Then
MsgBox "Dossier de destination introuvable"
Exit Sub
End If
On Error GoTo 0
' Vérification du nb de PJ et sortie du script si il n'y en a pas
Nb_PJ = MonMail.Attachments.Count
' If Nb_PJ = 0 Then Exit Sub
'
' ' Définition du répertoire temporaire et création si il
n'existe pas ' Rep = "c:temp"
' If Rep <> "" Then
' If Dir(Rep, vbDirectory) = "" Then
' MkDir Rep
' End If
' End If
'
' For Each objPJ In MonMail.Attachments
'
' If Left(objPJ.FileName, 3) = "ATT" Then
' objPJ.SaveAsFile Rep & objPJ.FileName
'
' ' Lecture du fichier à la recherche de la variable x
-LF - RoutingString
' FileID = FreeFile
' Open Rep & objPJ.FileName For Input As FileID
' Do While Not EOF(FileID)
' Line Input #FileID, LigFic
' If Left(LigFic, 18) = "X-LF-RoutingString" Then
' NumSDA = Right(LigFic, Len(LigFic) - 20)
' End If
' Loop
' Close #1
'
' ' Suppression du fichier temporaire
' Set ObjetFichier >>> CreateObject("Scripting.FileSystemObject") ' ObjetFichier.DeleteFile Rep
& objPJ.FileName, True ' Set
ObjetFichier = Nothing '
' End If
'
' Next
NumSDA = "111111111"
If NumSDA = "111111111" Then MonMail.Move DossierDest
End Sub
*Fabrice N." <"f.nebbia" dans le domaine "technicn.com <"f.nebbia" dans le
domaine "technicn.com"> que je salut a écrit *:Salut Oliv'
J'ai testé avec ta macro, j'ai le même résultat.
Plus de 30 s avant exécution du code. En plus, il ne me trouve pas le
dossier "Sous-Dossiers"
...
Je sais pas si c'est lié, mais depuis mon passage à Outlook 2003, j'ai
toujours remarqué un petit délai dans la reception de mes mails.
Quand j'envoie un mail, il faut que je change de dossier pour qu'il
disparaissent de la boîte d'envoi.
Pour la réception, c'est pareil, si je ne me déplace pas dans les
dossiers, je ne vois pas les nouveau messages...
Par contre, même une fois les messages arrivé, ma macros met un
certain temps à se lancer...
Et c'est pas une des instructions de la macro qui bloque car j'ai mis
un msgbox au tout début et il met un moment à apparaître aussi...
C'est à rien y comprendre...
tu es en pst ou exchange ?
Essaye en créant un profil test
"Oliv'" a écrit dans le
message de news:
*Fabrice N." <"f.nebbia" dans le domaine "technicn.com <"f.nebbia"
dans le domaine "technicn.com"> que je salut a écrit *:c'est ce que j'ai fait, et c'est ce qui m'a permis de me rendre
compte que le script mettait du temps à s'exécuter...
Je n'ai toujours pas compris pourquoi puisque lorsque je lance la
règle manuellement, l'exécution est instantanée...
dur dur ... !!!!
Le fait de redéfinir ta variable DossierDest à plusieurs reprises
est peut être la cause.
Chez moi le code ci-dessous (un peu modifié)est instantané,
également en mode mis en cache.
Sub TrierLesFax(MonMail As MailItem)
Dim objPJ As Attachment, ObjetFichier As Object
Dim LigFic As String, FileID As Integer
Dim NumSDA As String
Dim DossierDest As Outlook.MAPIFolder
Dim Rep As String, Nb_PJ As Integer
' Définition du dossier de destination "Boîte aux
lettres -MoiSous-DossiersSous-Sous-Dossier"
On Error Resume Next
Dim myolApp As Outlook.Application
Dim myNamespace As Outlook.NameSpace
Set myolApp = CreateObject("Outlook.Application")
Set myNamespace = myolApp.GetNamespace("MAPI")
Set myolApp.ActiveExplorer.CurrentFolder = _
myNamespace.GetDefaultFolder(olFolderInbox)
Set DossierDest >>> myolApp.ActiveExplorer.CurrentFolder.Folders.Item("Sous-Dossiers")
'Set DossierDest = DossierDest.Folders.Item("Sous-Sous-Dossier")
If Err <> 0 Then
MsgBox "Dossier de destination introuvable"
Exit Sub
End If
On Error GoTo 0
' Vérification du nb de PJ et sortie du script si il n'y en a pas
Nb_PJ = MonMail.Attachments.Count
' If Nb_PJ = 0 Then Exit Sub
'
' ' Définition du répertoire temporaire et création si il
n'existe pas ' Rep = "c:temp"
' If Rep <> "" Then
' If Dir(Rep, vbDirectory) = "" Then
' MkDir Rep
' End If
' End If
'
' For Each objPJ In MonMail.Attachments
'
' If Left(objPJ.FileName, 3) = "ATT" Then
' objPJ.SaveAsFile Rep & objPJ.FileName
'
' ' Lecture du fichier à la recherche de la variable x
-LF - RoutingString
' FileID = FreeFile
' Open Rep & objPJ.FileName For Input As FileID
' Do While Not EOF(FileID)
' Line Input #FileID, LigFic
' If Left(LigFic, 18) = "X-LF-RoutingString" Then
' NumSDA = Right(LigFic, Len(LigFic) - 20)
' End If
' Loop
' Close #1
'
' ' Suppression du fichier temporaire
' Set ObjetFichier >>> CreateObject("Scripting.FileSystemObject") ' ObjetFichier.DeleteFile Rep
& objPJ.FileName, True ' Set
ObjetFichier = Nothing '
' End If
'
' Next
NumSDA = "111111111"
If NumSDA = "111111111" Then MonMail.Move DossierDest
End Sub
*Fabrice N." <"f.nebbia" dans le domaine "technicn.com <"f.nebbia" dans le
domaine "technicn.com"> que je salut a écrit *:Salut Oliv'
J'ai testé avec ta macro, j'ai le même résultat.
Plus de 30 s avant exécution du code. En plus, il ne me trouve pas le
dossier "Sous-Dossiers"
...
Je sais pas si c'est lié, mais depuis mon passage à Outlook 2003, j'ai
toujours remarqué un petit délai dans la reception de mes mails.
Quand j'envoie un mail, il faut que je change de dossier pour qu'il
disparaissent de la boîte d'envoi.
Pour la réception, c'est pareil, si je ne me déplace pas dans les
dossiers, je ne vois pas les nouveau messages...
Par contre, même une fois les messages arrivé, ma macros met un
certain temps à se lancer...
Et c'est pas une des instructions de la macro qui bloque car j'ai mis
un msgbox au tout début et il met un moment à apparaître aussi...
C'est à rien y comprendre...
tu es en pst ou exchange ?
Essaye en créant un profil test
"Oliv'" a écrit dans le
message de news:
*Fabrice N." <"f.nebbia" dans le domaine "technicn.com <"f.nebbia"
dans le domaine "technicn.com"> que je salut a écrit *:c'est ce que j'ai fait, et c'est ce qui m'a permis de me rendre
compte que le script mettait du temps à s'exécuter...
Je n'ai toujours pas compris pourquoi puisque lorsque je lance la
règle manuellement, l'exécution est instantanée...
dur dur ... !!!!
Le fait de redéfinir ta variable DossierDest à plusieurs reprises
est peut être la cause.
Chez moi le code ci-dessous (un peu modifié)est instantané,
également en mode mis en cache.
Sub TrierLesFax(MonMail As MailItem)
Dim objPJ As Attachment, ObjetFichier As Object
Dim LigFic As String, FileID As Integer
Dim NumSDA As String
Dim DossierDest As Outlook.MAPIFolder
Dim Rep As String, Nb_PJ As Integer
' Définition du dossier de destination "Boîte aux
lettres -MoiSous-DossiersSous-Sous-Dossier"
On Error Resume Next
Dim myolApp As Outlook.Application
Dim myNamespace As Outlook.NameSpace
Set myolApp = CreateObject("Outlook.Application")
Set myNamespace = myolApp.GetNamespace("MAPI")
Set myolApp.ActiveExplorer.CurrentFolder = _
myNamespace.GetDefaultFolder(olFolderInbox)
Set DossierDest >>> myolApp.ActiveExplorer.CurrentFolder.Folders.Item("Sous-Dossiers")
'Set DossierDest = DossierDest.Folders.Item("Sous-Sous-Dossier")
If Err <> 0 Then
MsgBox "Dossier de destination introuvable"
Exit Sub
End If
On Error GoTo 0
' Vérification du nb de PJ et sortie du script si il n'y en a pas
Nb_PJ = MonMail.Attachments.Count
' If Nb_PJ = 0 Then Exit Sub
'
' ' Définition du répertoire temporaire et création si il
n'existe pas ' Rep = "c:temp"
' If Rep <> "" Then
' If Dir(Rep, vbDirectory) = "" Then
' MkDir Rep
' End If
' End If
'
' For Each objPJ In MonMail.Attachments
'
' If Left(objPJ.FileName, 3) = "ATT" Then
' objPJ.SaveAsFile Rep & objPJ.FileName
'
' ' Lecture du fichier à la recherche de la variable x
-LF - RoutingString
' FileID = FreeFile
' Open Rep & objPJ.FileName For Input As FileID
' Do While Not EOF(FileID)
' Line Input #FileID, LigFic
' If Left(LigFic, 18) = "X-LF-RoutingString" Then
' NumSDA = Right(LigFic, Len(LigFic) - 20)
' End If
' Loop
' Close #1
'
' ' Suppression du fichier temporaire
' Set ObjetFichier >>> CreateObject("Scripting.FileSystemObject") ' ObjetFichier.DeleteFile Rep
& objPJ.FileName, True ' Set
ObjetFichier = Nothing '
' End If
'
' Next
NumSDA = "111111111"
If NumSDA = "111111111" Then MonMail.Move DossierDest
End Sub
*Fabrice N." <"f.nebbia" dans le domaine "technicn.com <"f.nebbia" dans le
domaine "technicn.com"> que je salut a écrit *:
Salut Oliv'
J'ai testé avec ta macro, j'ai le même résultat.
Plus de 30 s avant exécution du code. En plus, il ne me trouve pas le
dossier "Sous-Dossiers"
...
Je sais pas si c'est lié, mais depuis mon passage à Outlook 2003, j'ai
toujours remarqué un petit délai dans la reception de mes mails.
Quand j'envoie un mail, il faut que je change de dossier pour qu'il
disparaissent de la boîte d'envoi.
Pour la réception, c'est pareil, si je ne me déplace pas dans les
dossiers, je ne vois pas les nouveau messages...
Par contre, même une fois les messages arrivé, ma macros met un
certain temps à se lancer...
Et c'est pas une des instructions de la macro qui bloque car j'ai mis
un msgbox au tout début et il met un moment à apparaître aussi...
C'est à rien y comprendre...
tu es en pst ou exchange ?
Essaye en créant un profil test
"Oliv'" <SUPPRIMERCECIcatteau@ricour-assurances.fr> a écrit dans le
message de news: eaux5CcAHHA.3316@TK2MSFTNGP02.phx.gbl...
*Fabrice N." <"f.nebbia" dans le domaine "technicn.com <"f.nebbia"
dans le domaine "technicn.com"> que je salut a écrit *:
c'est ce que j'ai fait, et c'est ce qui m'a permis de me rendre
compte que le script mettait du temps à s'exécuter...
Je n'ai toujours pas compris pourquoi puisque lorsque je lance la
règle manuellement, l'exécution est instantanée...
dur dur ... !!!!
Le fait de redéfinir ta variable DossierDest à plusieurs reprises
est peut être la cause.
Chez moi le code ci-dessous (un peu modifié)est instantané,
également en mode mis en cache.
Sub TrierLesFax(MonMail As MailItem)
Dim objPJ As Attachment, ObjetFichier As Object
Dim LigFic As String, FileID As Integer
Dim NumSDA As String
Dim DossierDest As Outlook.MAPIFolder
Dim Rep As String, Nb_PJ As Integer
' Définition du dossier de destination "Boîte aux
lettres -MoiSous-DossiersSous-Sous-Dossier"
On Error Resume Next
Dim myolApp As Outlook.Application
Dim myNamespace As Outlook.NameSpace
Set myolApp = CreateObject("Outlook.Application")
Set myNamespace = myolApp.GetNamespace("MAPI")
Set myolApp.ActiveExplorer.CurrentFolder = _
myNamespace.GetDefaultFolder(olFolderInbox)
Set DossierDest >>> myolApp.ActiveExplorer.CurrentFolder.Folders.Item("Sous-Dossiers")
'Set DossierDest = DossierDest.Folders.Item("Sous-Sous-Dossier")
If Err <> 0 Then
MsgBox "Dossier de destination introuvable"
Exit Sub
End If
On Error GoTo 0
' Vérification du nb de PJ et sortie du script si il n'y en a pas
Nb_PJ = MonMail.Attachments.Count
' If Nb_PJ = 0 Then Exit Sub
'
' ' Définition du répertoire temporaire et création si il
n'existe pas ' Rep = "c:temp"
' If Rep <> "" Then
' If Dir(Rep, vbDirectory) = "" Then
' MkDir Rep
' End If
' End If
'
' For Each objPJ In MonMail.Attachments
'
' If Left(objPJ.FileName, 3) = "ATT" Then
' objPJ.SaveAsFile Rep & objPJ.FileName
'
' ' Lecture du fichier à la recherche de la variable x
-LF - RoutingString
' FileID = FreeFile
' Open Rep & objPJ.FileName For Input As FileID
' Do While Not EOF(FileID)
' Line Input #FileID, LigFic
' If Left(LigFic, 18) = "X-LF-RoutingString" Then
' NumSDA = Right(LigFic, Len(LigFic) - 20)
' End If
' Loop
' Close #1
'
' ' Suppression du fichier temporaire
' Set ObjetFichier >>> CreateObject("Scripting.FileSystemObject") ' ObjetFichier.DeleteFile Rep
& objPJ.FileName, True ' Set
ObjetFichier = Nothing '
' End If
'
' Next
NumSDA = "111111111"
If NumSDA = "111111111" Then MonMail.Move DossierDest
End Sub
*Fabrice N." <"f.nebbia" dans le domaine "technicn.com <"f.nebbia" dans le
domaine "technicn.com"> que je salut a écrit *:Salut Oliv'
J'ai testé avec ta macro, j'ai le même résultat.
Plus de 30 s avant exécution du code. En plus, il ne me trouve pas le
dossier "Sous-Dossiers"
...
Je sais pas si c'est lié, mais depuis mon passage à Outlook 2003, j'ai
toujours remarqué un petit délai dans la reception de mes mails.
Quand j'envoie un mail, il faut que je change de dossier pour qu'il
disparaissent de la boîte d'envoi.
Pour la réception, c'est pareil, si je ne me déplace pas dans les
dossiers, je ne vois pas les nouveau messages...
Par contre, même une fois les messages arrivé, ma macros met un
certain temps à se lancer...
Et c'est pas une des instructions de la macro qui bloque car j'ai mis
un msgbox au tout début et il met un moment à apparaître aussi...
C'est à rien y comprendre...
tu es en pst ou exchange ?
Essaye en créant un profil test
"Oliv'" a écrit dans le
message de news:
*Fabrice N." <"f.nebbia" dans le domaine "technicn.com <"f.nebbia"
dans le domaine "technicn.com"> que je salut a écrit *:c'est ce que j'ai fait, et c'est ce qui m'a permis de me rendre
compte que le script mettait du temps à s'exécuter...
Je n'ai toujours pas compris pourquoi puisque lorsque je lance la
règle manuellement, l'exécution est instantanée...
dur dur ... !!!!
Le fait de redéfinir ta variable DossierDest à plusieurs reprises
est peut être la cause.
Chez moi le code ci-dessous (un peu modifié)est instantané,
également en mode mis en cache.
Sub TrierLesFax(MonMail As MailItem)
Dim objPJ As Attachment, ObjetFichier As Object
Dim LigFic As String, FileID As Integer
Dim NumSDA As String
Dim DossierDest As Outlook.MAPIFolder
Dim Rep As String, Nb_PJ As Integer
' Définition du dossier de destination "Boîte aux
lettres -MoiSous-DossiersSous-Sous-Dossier"
On Error Resume Next
Dim myolApp As Outlook.Application
Dim myNamespace As Outlook.NameSpace
Set myolApp = CreateObject("Outlook.Application")
Set myNamespace = myolApp.GetNamespace("MAPI")
Set myolApp.ActiveExplorer.CurrentFolder = _
myNamespace.GetDefaultFolder(olFolderInbox)
Set DossierDest >>> myolApp.ActiveExplorer.CurrentFolder.Folders.Item("Sous-Dossiers")
'Set DossierDest = DossierDest.Folders.Item("Sous-Sous-Dossier")
If Err <> 0 Then
MsgBox "Dossier de destination introuvable"
Exit Sub
End If
On Error GoTo 0
' Vérification du nb de PJ et sortie du script si il n'y en a pas
Nb_PJ = MonMail.Attachments.Count
' If Nb_PJ = 0 Then Exit Sub
'
' ' Définition du répertoire temporaire et création si il
n'existe pas ' Rep = "c:temp"
' If Rep <> "" Then
' If Dir(Rep, vbDirectory) = "" Then
' MkDir Rep
' End If
' End If
'
' For Each objPJ In MonMail.Attachments
'
' If Left(objPJ.FileName, 3) = "ATT" Then
' objPJ.SaveAsFile Rep & objPJ.FileName
'
' ' Lecture du fichier à la recherche de la variable x
-LF - RoutingString
' FileID = FreeFile
' Open Rep & objPJ.FileName For Input As FileID
' Do While Not EOF(FileID)
' Line Input #FileID, LigFic
' If Left(LigFic, 18) = "X-LF-RoutingString" Then
' NumSDA = Right(LigFic, Len(LigFic) - 20)
' End If
' Loop
' Close #1
'
' ' Suppression du fichier temporaire
' Set ObjetFichier >>> CreateObject("Scripting.FileSystemObject") ' ObjetFichier.DeleteFile Rep
& objPJ.FileName, True ' Set
ObjetFichier = Nothing '
' End If
'
' Next
NumSDA = "111111111"
If NumSDA = "111111111" Then MonMail.Move DossierDest
End Sub
Encore moi !
Je viens d'essayer ma macro sur un autre poste et elle fonctionne sans
problème.
Donc le problème viens bien de mon poste...
bin c'est du propre, ca doit venir des jeux installer sur ton poste ;-)))
Par contre, concernant la signature numérique. J'ai créer le fameux
certificat et signé la macro sur mon poste.
Mais comment je fais pour ajouter la macro avec la signature sur
d'autres PC.
J'ai essayé en exportant le module et en le réimportant, mais je n'ai
plus de certificat.
"Oliv'" a écrit dans le
message de news: %23Xqu$
*Fabrice N." <"f.nebbia" dans le domaine "technicn.com <"f.nebbia"
dans le domaine "technicn.com"> que je salut a écrit *:Salut Oliv'
J'ai testé avec ta macro, j'ai le même résultat.
Plus de 30 s avant exécution du code. En plus, il ne me trouve pas
le dossier "Sous-Dossiers"
...
Je sais pas si c'est lié, mais depuis mon passage à Outlook 2003,
j'ai toujours remarqué un petit délai dans la reception de mes
mails. Quand j'envoie un mail, il faut que je change de dossier
pour qu'il disparaissent de la boîte d'envoi.
Pour la réception, c'est pareil, si je ne me déplace pas dans les
dossiers, je ne vois pas les nouveau messages...
Par contre, même une fois les messages arrivé, ma macros met un
certain temps à se lancer...
Et c'est pas une des instructions de la macro qui bloque car j'ai
mis un msgbox au tout début et il met un moment à apparaître
aussi... C'est à rien y comprendre...
tu es en pst ou exchange ?
Essaye en créant un profil test
"Oliv'" a écrit dans le
message de news:
*Fabrice N." <"f.nebbia" dans le domaine "technicn.com <"f.nebbia"
dans le domaine "technicn.com"> que je salut a écrit *:c'est ce que j'ai fait, et c'est ce qui m'a permis de me rendre
compte que le script mettait du temps à s'exécuter...
Je n'ai toujours pas compris pourquoi puisque lorsque je lance la
règle manuellement, l'exécution est instantanée...
dur dur ... !!!!
Le fait de redéfinir ta variable DossierDest à plusieurs reprises
est peut être la cause.
Chez moi le code ci-dessous (un peu modifié)est instantané,
également en mode mis en cache.
Sub TrierLesFax(MonMail As MailItem)
Dim objPJ As Attachment, ObjetFichier As Object
Dim LigFic As String, FileID As Integer
Dim NumSDA As String
Dim DossierDest As Outlook.MAPIFolder
Dim Rep As String, Nb_PJ As Integer
' Définition du dossier de destination "Boîte aux
lettres -MoiSous-DossiersSous-Sous-Dossier"
On Error Resume Next
Dim myolApp As Outlook.Application
Dim myNamespace As Outlook.NameSpace
Set myolApp = CreateObject("Outlook.Application")
Set myNamespace = myolApp.GetNamespace("MAPI")
Set myolApp.ActiveExplorer.CurrentFolder = _
myNamespace.GetDefaultFolder(olFolderInbox)
Set DossierDest >>>> myolApp.ActiveExplorer.CurrentFolder.Folders.Item("Sous-Dossiers")
'Set DossierDest = DossierDest.Folders.Item("Sous-Sous-Dossier")
If Err <> 0 Then
MsgBox "Dossier de destination introuvable"
Exit Sub
End If
On Error GoTo 0
' Vérification du nb de PJ et sortie du script si il n'y en a
pas Nb_PJ = MonMail.Attachments.Count
' If Nb_PJ = 0 Then Exit Sub
'
' ' Définition du répertoire temporaire et création si il
n'existe pas ' Rep = "c:temp"
' If Rep <> "" Then
' If Dir(Rep, vbDirectory) = "" Then
' MkDir Rep
' End If
' End If
'
' For Each objPJ In MonMail.Attachments
'
' If Left(objPJ.FileName, 3) = "ATT" Then
' objPJ.SaveAsFile Rep & objPJ.FileName
'
' ' Lecture du fichier à la recherche de la variable x
-LF - RoutingString
' FileID = FreeFile
' Open Rep & objPJ.FileName For Input As FileID
' Do While Not EOF(FileID)
' Line Input #FileID, LigFic
' If Left(LigFic, 18) = "X-LF-RoutingString" Then
' NumSDA = Right(LigFic, Len(LigFic) - 20)
' End If
' Loop
' Close #1
'
' ' Suppression du fichier temporaire
' Set ObjetFichier >>>> CreateObject("Scripting.FileSystemObject") '
ObjetFichier.DeleteFile Rep & objPJ.FileName, True ' Set
ObjetFichier = Nothing '
' End If
'
' Next
NumSDA = "111111111"
If NumSDA = "111111111" Then MonMail.Move DossierDest
End Sub
Encore moi !
Je viens d'essayer ma macro sur un autre poste et elle fonctionne sans
problème.
Donc le problème viens bien de mon poste...
bin c'est du propre, ca doit venir des jeux installer sur ton poste ;-)))
Par contre, concernant la signature numérique. J'ai créer le fameux
certificat et signé la macro sur mon poste.
Mais comment je fais pour ajouter la macro avec la signature sur
d'autres PC.
J'ai essayé en exportant le module et en le réimportant, mais je n'ai
plus de certificat.
"Oliv'" <SUPPRIMERCECIcatteau@ricour-assurances.fr> a écrit dans le
message de news: %23Xqu$8kAHHA.2328@TK2MSFTNGP02.phx.gbl...
*Fabrice N." <"f.nebbia" dans le domaine "technicn.com <"f.nebbia"
dans le domaine "technicn.com"> que je salut a écrit *:
Salut Oliv'
J'ai testé avec ta macro, j'ai le même résultat.
Plus de 30 s avant exécution du code. En plus, il ne me trouve pas
le dossier "Sous-Dossiers"
...
Je sais pas si c'est lié, mais depuis mon passage à Outlook 2003,
j'ai toujours remarqué un petit délai dans la reception de mes
mails. Quand j'envoie un mail, il faut que je change de dossier
pour qu'il disparaissent de la boîte d'envoi.
Pour la réception, c'est pareil, si je ne me déplace pas dans les
dossiers, je ne vois pas les nouveau messages...
Par contre, même une fois les messages arrivé, ma macros met un
certain temps à se lancer...
Et c'est pas une des instructions de la macro qui bloque car j'ai
mis un msgbox au tout début et il met un moment à apparaître
aussi... C'est à rien y comprendre...
tu es en pst ou exchange ?
Essaye en créant un profil test
"Oliv'" <SUPPRIMERCECIcatteau@ricour-assurances.fr> a écrit dans le
message de news: eaux5CcAHHA.3316@TK2MSFTNGP02.phx.gbl...
*Fabrice N." <"f.nebbia" dans le domaine "technicn.com <"f.nebbia"
dans le domaine "technicn.com"> que je salut a écrit *:
c'est ce que j'ai fait, et c'est ce qui m'a permis de me rendre
compte que le script mettait du temps à s'exécuter...
Je n'ai toujours pas compris pourquoi puisque lorsque je lance la
règle manuellement, l'exécution est instantanée...
dur dur ... !!!!
Le fait de redéfinir ta variable DossierDest à plusieurs reprises
est peut être la cause.
Chez moi le code ci-dessous (un peu modifié)est instantané,
également en mode mis en cache.
Sub TrierLesFax(MonMail As MailItem)
Dim objPJ As Attachment, ObjetFichier As Object
Dim LigFic As String, FileID As Integer
Dim NumSDA As String
Dim DossierDest As Outlook.MAPIFolder
Dim Rep As String, Nb_PJ As Integer
' Définition du dossier de destination "Boîte aux
lettres -MoiSous-DossiersSous-Sous-Dossier"
On Error Resume Next
Dim myolApp As Outlook.Application
Dim myNamespace As Outlook.NameSpace
Set myolApp = CreateObject("Outlook.Application")
Set myNamespace = myolApp.GetNamespace("MAPI")
Set myolApp.ActiveExplorer.CurrentFolder = _
myNamespace.GetDefaultFolder(olFolderInbox)
Set DossierDest >>>> myolApp.ActiveExplorer.CurrentFolder.Folders.Item("Sous-Dossiers")
'Set DossierDest = DossierDest.Folders.Item("Sous-Sous-Dossier")
If Err <> 0 Then
MsgBox "Dossier de destination introuvable"
Exit Sub
End If
On Error GoTo 0
' Vérification du nb de PJ et sortie du script si il n'y en a
pas Nb_PJ = MonMail.Attachments.Count
' If Nb_PJ = 0 Then Exit Sub
'
' ' Définition du répertoire temporaire et création si il
n'existe pas ' Rep = "c:temp"
' If Rep <> "" Then
' If Dir(Rep, vbDirectory) = "" Then
' MkDir Rep
' End If
' End If
'
' For Each objPJ In MonMail.Attachments
'
' If Left(objPJ.FileName, 3) = "ATT" Then
' objPJ.SaveAsFile Rep & objPJ.FileName
'
' ' Lecture du fichier à la recherche de la variable x
-LF - RoutingString
' FileID = FreeFile
' Open Rep & objPJ.FileName For Input As FileID
' Do While Not EOF(FileID)
' Line Input #FileID, LigFic
' If Left(LigFic, 18) = "X-LF-RoutingString" Then
' NumSDA = Right(LigFic, Len(LigFic) - 20)
' End If
' Loop
' Close #1
'
' ' Suppression du fichier temporaire
' Set ObjetFichier >>>> CreateObject("Scripting.FileSystemObject") '
ObjetFichier.DeleteFile Rep & objPJ.FileName, True ' Set
ObjetFichier = Nothing '
' End If
'
' Next
NumSDA = "111111111"
If NumSDA = "111111111" Then MonMail.Move DossierDest
End Sub
Encore moi !
Je viens d'essayer ma macro sur un autre poste et elle fonctionne sans
problème.
Donc le problème viens bien de mon poste...
bin c'est du propre, ca doit venir des jeux installer sur ton poste ;-)))
Par contre, concernant la signature numérique. J'ai créer le fameux
certificat et signé la macro sur mon poste.
Mais comment je fais pour ajouter la macro avec la signature sur
d'autres PC.
J'ai essayé en exportant le module et en le réimportant, mais je n'ai
plus de certificat.
"Oliv'" a écrit dans le
message de news: %23Xqu$
*Fabrice N." <"f.nebbia" dans le domaine "technicn.com <"f.nebbia"
dans le domaine "technicn.com"> que je salut a écrit *:Salut Oliv'
J'ai testé avec ta macro, j'ai le même résultat.
Plus de 30 s avant exécution du code. En plus, il ne me trouve pas
le dossier "Sous-Dossiers"
...
Je sais pas si c'est lié, mais depuis mon passage à Outlook 2003,
j'ai toujours remarqué un petit délai dans la reception de mes
mails. Quand j'envoie un mail, il faut que je change de dossier
pour qu'il disparaissent de la boîte d'envoi.
Pour la réception, c'est pareil, si je ne me déplace pas dans les
dossiers, je ne vois pas les nouveau messages...
Par contre, même une fois les messages arrivé, ma macros met un
certain temps à se lancer...
Et c'est pas une des instructions de la macro qui bloque car j'ai
mis un msgbox au tout début et il met un moment à apparaître
aussi... C'est à rien y comprendre...
tu es en pst ou exchange ?
Essaye en créant un profil test
"Oliv'" a écrit dans le
message de news:
*Fabrice N." <"f.nebbia" dans le domaine "technicn.com <"f.nebbia"
dans le domaine "technicn.com"> que je salut a écrit *:c'est ce que j'ai fait, et c'est ce qui m'a permis de me rendre
compte que le script mettait du temps à s'exécuter...
Je n'ai toujours pas compris pourquoi puisque lorsque je lance la
règle manuellement, l'exécution est instantanée...
dur dur ... !!!!
Le fait de redéfinir ta variable DossierDest à plusieurs reprises
est peut être la cause.
Chez moi le code ci-dessous (un peu modifié)est instantané,
également en mode mis en cache.
Sub TrierLesFax(MonMail As MailItem)
Dim objPJ As Attachment, ObjetFichier As Object
Dim LigFic As String, FileID As Integer
Dim NumSDA As String
Dim DossierDest As Outlook.MAPIFolder
Dim Rep As String, Nb_PJ As Integer
' Définition du dossier de destination "Boîte aux
lettres -MoiSous-DossiersSous-Sous-Dossier"
On Error Resume Next
Dim myolApp As Outlook.Application
Dim myNamespace As Outlook.NameSpace
Set myolApp = CreateObject("Outlook.Application")
Set myNamespace = myolApp.GetNamespace("MAPI")
Set myolApp.ActiveExplorer.CurrentFolder = _
myNamespace.GetDefaultFolder(olFolderInbox)
Set DossierDest >>>> myolApp.ActiveExplorer.CurrentFolder.Folders.Item("Sous-Dossiers")
'Set DossierDest = DossierDest.Folders.Item("Sous-Sous-Dossier")
If Err <> 0 Then
MsgBox "Dossier de destination introuvable"
Exit Sub
End If
On Error GoTo 0
' Vérification du nb de PJ et sortie du script si il n'y en a
pas Nb_PJ = MonMail.Attachments.Count
' If Nb_PJ = 0 Then Exit Sub
'
' ' Définition du répertoire temporaire et création si il
n'existe pas ' Rep = "c:temp"
' If Rep <> "" Then
' If Dir(Rep, vbDirectory) = "" Then
' MkDir Rep
' End If
' End If
'
' For Each objPJ In MonMail.Attachments
'
' If Left(objPJ.FileName, 3) = "ATT" Then
' objPJ.SaveAsFile Rep & objPJ.FileName
'
' ' Lecture du fichier à la recherche de la variable x
-LF - RoutingString
' FileID = FreeFile
' Open Rep & objPJ.FileName For Input As FileID
' Do While Not EOF(FileID)
' Line Input #FileID, LigFic
' If Left(LigFic, 18) = "X-LF-RoutingString" Then
' NumSDA = Right(LigFic, Len(LigFic) - 20)
' End If
' Loop
' Close #1
'
' ' Suppression du fichier temporaire
' Set ObjetFichier >>>> CreateObject("Scripting.FileSystemObject") '
ObjetFichier.DeleteFile Rep & objPJ.FileName, True ' Set
ObjetFichier = Nothing '
' End If
'
' Next
NumSDA = "111111111"
If NumSDA = "111111111" Then MonMail.Move DossierDest
End Sub