OK, merci pour le tuyau. Pour la validation du certificat, je m'en doutais, lais ça ne me gêne pas, je bosse pas dans une multi nationnale, je devrait m'en sortir... ;o)
"Oliv'" a écrit dans le message de news: %23ijl%
*Fabrice N." <"f.nebbia" dans le domaine "technicn.com <"f.nebbia" dans le domaine "technicn.com"> que je salut a écrit *:
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.
le plus simple c'est de copier le fichier C:Documents and SettingsMonprofilApplication DataMicrosoftOutlookVbaProject.OTM ou %appdata%MicrosoftOutlookVbaProject.OTM sur chaque poste mais pour le certificat il faut l'installer à partir du message de sécurité poste par poste.
"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
OK, merci pour le tuyau.
Pour la validation du certificat, je m'en doutais, lais ça ne me gêne pas,
je bosse pas dans une multi nationnale, je devrait m'en sortir... ;o)
"Oliv'" <SUPPRIMERCECIcatteau@ricour-assurances.fr> a écrit dans le message
de news: %23ijl%23NnAHHA.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 *:
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.
le plus simple c'est de copier le fichier
C:Documents and SettingsMonprofilApplication
DataMicrosoftOutlookVbaProject.OTM
ou %appdata%MicrosoftOutlookVbaProject.OTM
sur chaque poste
mais pour le certificat il faut l'installer à partir du message de
sécurité poste par poste.
"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
OK, merci pour le tuyau. Pour la validation du certificat, je m'en doutais, lais ça ne me gêne pas, je bosse pas dans une multi nationnale, je devrait m'en sortir... ;o)
"Oliv'" a écrit dans le message de news: %23ijl%
*Fabrice N." <"f.nebbia" dans le domaine "technicn.com <"f.nebbia" dans le domaine "technicn.com"> que je salut a écrit *:
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.
le plus simple c'est de copier le fichier C:Documents and SettingsMonprofilApplication DataMicrosoftOutlookVbaProject.OTM ou %appdata%MicrosoftOutlookVbaProject.OTM sur chaque poste mais pour le certificat il faut l'installer à partir du message de sécurité poste par poste.
"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
