ENVOIE DE MAIL

Commentaire de DakM le 26/01/2005 16:45:15

Petite erreur :
A la ligne ou ya ecrit ".SEND"

Commentaire de aeder le 27/01/2005 12:55:45

Effectivement Outlook signale un problème de sécurité et bloque l'ordi pendant 10 secondes ce qui est très embétant. Comment éviter cela ?

Commentaire de lapinblanc le 27/01/2005 16:02:04

ba super... c'est simple et ça convient très bien pour une utilisation perso...

par contre, toujours pas de solution intégré pour Outlook...

bonne source et bonnes infos.

merci.

Commentaire de stillfelil le 07/03/2005 22:59:13

ok sa marche,mé kom ta di ya le hic d'outlook ki risk 2 foutr la merd sa na pa été mi a jour,tu propoz koi pr la détourné

Commentaire de raysat le 21/05/2005 16:31:41

Je travaille sur vb.net et il y a la variable "any" qui n est pas supporté dans vb.net  que faire ? proteus91

Merci d avance
raysat
rheaberberi@hotmail.com

Commentaire de raysat le 21/05/2005 16:34:08

Je travaille sur vb.net et il y a la variable "any" qui n est pas supporté dans vb.net  que faire ? proteus91

Merci d avance
raysat
rheaberberi@hotmail.com

Commentaire de defdlm le 15/09/2006 09:10:36

Bonjour à tous,
C'est juste pour vous dire qu'on peux faire mieux, j'ai fait un petite applis qui dois traiter des mails et envoie ensuite un mail de confirmation comme quoi le traitement est Ok
Et le plus c'est que pas besoin de click Yes ca envoie le mail et outlook ne dis rien


Source:
'*****************************************************************************************************
'*  Nom : Recup PJ DUE
'*  Date de création : 14/06/2006
'*  Auteur : Perney-loisel Frédéric
'*  Description : Permet de récuperer les DUE's de outlook (Dossier Public DUE),d'enregistrer la piece jointe dans le bon repetoire et deplace le mail ds DUEOK
'*****************************************************************************************************

'Option Explicit

Dim objoutlook As Outlook.Application
Dim olns As Outlook.NameSpace
Dim mItem As Outlook.MailItem
Dim att As Outlook.Attachment
Dim fld As Outlook.MAPIFolder
Dim lcompteur, Lnbrpassage As Integer
Public Mfile As String


Private Sub Form_load()
    lcompteur = 0
    Lnbrpassage = 0
    LTraitementPrincipal
End Sub



Private Sub Form_Unload(Cancel As Integer)
    Set fld = Nothing
    Set olns = Nothing
    Set objoutlook = Nothing
End Sub

Public Sub Pause(temps_a_attendre As Integer)

    Dim endtime As Date
    endtime = DateAdd("s", temps_a_attendre, Now)
    
    Do Until Now > endtime
        DoEvents
    Loop

End Sub

Public Sub LTraitementPrincipal()
'On Error GoTo errorhandler
'Création de l'objet Outlook
Set objoutlook = CreateObject("Outlook.application")
'Récupération de l'espace de nom d'outlook
Set olns = objoutlook.GetNamespace("MAPI")

'Récupération du répertoire "dossier public" par défault

Set fld = olns.GetDefaultFolder(olPublicFoldersAllPublicFolders)

'Sauver les pieces jointes des mails se trouvant dans
'la boîte de réception. Pour adresser un dossier dans la boite
'de réception on pourrait utiliser :
'fld.Folders.Item("Nom_Du_Dossier").Items

'parcour des mails dans dossier public\test
For Each mItem In fld.Folders.Item("DUE").Items
    'On incremente un compteur
    lcompteur = lcompteur + 1

    For Each att In mItem.Attachments 'pour chaque mail on recupere la piece jointe
        If att.Type = olByValue Then
            
            MonChemin = "\\SGECOMA9\d$\SPECIFIQUE\SERVICE_PAIE\_COMMUN\DUE\Cirso\AR\" & att.FileName 'on le place dans un repertoire sur le disque
            att.SaveAsFile MonChemin
            
            'att.SaveAsFile "c:\temp\" & att.FileName
            'MsgBox "deleter le fichier"
            Debug.Print "le fichier " & att.FileName & " a ete sauvegardé." 'commentaire d'execution
            lstlog.AddItem att.FileName 'On affiche dans la liste box le nom du fichier sauvegarder
        End If
    Pause (20) ' appel de fonction qui met en pause notre probleme est que le repertoire cible imprime les piece jointe
                ' mais il faut lui laisser un temp d'action
    TestFichierPresent 'Procedure qui test la presence du fichier si present on attend sinon on continue
    Next
Next

Do   'boucle qui va permettre de deplacer les mails d'un repertoire a l'autre
    For Each mItem In fld.Folders.Item("DUE").Items
        
        mItem.Move fld.Folders.Item("DUE OK")
    
    Next
    lcompteur = lcompteur - 1
Loop While lcompteur > 0

lstlog.AddItem "-------------- Export terminer -------------- "
LEnvoieCdoMail
Exit Sub

errorhandler:
MsgBox Err.Description, , Err.Source
LEnvoieCdoMailErreur
End Sub



Public Sub TestFichierPresent()

Do
    If Dir("\\SGECOMA9\d$\SPECIFIQUE\SERVICE_PAIE\_COMMUN\DUE\Cirso\AR\dpae.txt") <> "" Then
    'If Dir("c:\temp\") <> "" Then
        fileexist = True
        Lnbrpassage = Lnbrpassage + 1
        'MsgBox fileexist 'fichier present
        'on attend que le traitement se poursuive
      
        If Lnbrpassage > 1 Then
            'envoyer message d'erreur de traitement
            MsgBox "erreur de traitement --- " & att.FileName, vbOKOnly
            'LenvoieMail 'fonction d'envoie de mail
            
                LEnvoieCdoMailErreur 'fonction d'envoie de mail 2eme méthode (CDO)
                'Exit Do
                End
            
        Else
            Pause (20)
        End If
        
       Else
       Lnbrpassage = 0
        fileexist = False
        'MsgBox fileexist 'fichier absent
        'si le fichier est absent alors le traitement c'est bien passer
        Debug.Print "le fichier " & att.FileName & " est imprimer."
        Mfile = att.FileName
    End If
Loop While Dir("\\SGECOMA9\d$\SPECIFIQUE\SERVICE_PAIE\_COMMUN\DUE\Cirso\AR\dpae.txt") <> ""

'End
End Sub


Public Sub LEnvoieCdoMail()

Dim iMsg As New CDO.Message
Dim iConf As New CDO.Configuration
  
Dim Flds As ADODB.Fields
Set Flds = iConf.Fields
  
With Flds
   .Item(cdoSendUsingMethod) = cdoSendUsingPort
   .Item(cdoSMTPServer) = "GEC-CTRL" ' Si vous utilisez la librairie CDO pour exchange
   '.Item(cdoSMTPServerName) = "un serveur SMTP"    ' Si vous utilisez la librairie CDO pour Windows 2000
   .Item(cdoSMTPConnectionTimeout) = 10
   .Item(cdoSMTPAuthenticate) = cdoBasic
   .Item(cdoSendUserName) = "Login"
   .Item(cdoSendPassword) = "Motdepasse"
   .Item(cdoURLProxyServer) = "server:80"
   .Item(cdoURLProxyBypass) = "<local>"
   .Item(cdoURLGetLatestVersion) = True
   .Update
End With

With iMsg
   Set .Configuration = iConf
       .To = """Admin GECOMA"" <MAil@Mail.com>"
       .From = """Récup PJ DUE"" <MAil@Mail.Com>"
       .Subject = "DUE OK"
       .TextBody = "Traitement des DUE éffectués"
       '.AddAttachment "C:\un fichier quelconque"
       .Send
End With



Exit Sub

End Sub

Public Sub LEnvoieCdoMailErreur()

Dim iMsg As New CDO.Message
Dim iConf As New CDO.Configuration
  
Dim Flds As ADODB.Fields
Set Flds = iConf.Fields
  
    With Flds
      .Item(cdoSendUsingMethod) = cdoSendUsingPort
      .Item(cdoSMTPServer) = "NomServeur Smtp" ' Si vous utilisez la librairie CDO pour exchange
      '.Item(cdoSMTPServerName) = "un serveur SMTP"    ' Si vous utilisez la librairie CDO pour Windows 2000
      .Item(cdoSMTPConnectionTimeout) = 10
      .Item(cdoSMTPAuthenticate) = cdoBasic
      .Item(cdoSendUserName) = "Login"
      .Item(cdoSendPassword) = "Motdepasse"
      .Item(cdoURLProxyServer) = "server:80"
      .Item(cdoURLProxyBypass) = "<local>"
      .Item(cdoURLGetLatestVersion) = True
      .Update
    End With
    
     With iMsg
       On Error Resume Next
      Set .Configuration = iConf
          .To = """Admin GECOMA"" <MAil@Mail.com>"
          .From = """Récup PJ DUE"" <MAil@Mail.Com>"
          .Subject = "Erreur DUE"
          .TextBody = "Vérifier les DUE, Le fichier " & Mfile & " " & Err.Description & " " & Err.Source
          '.AddAttachment "C:\un fichier quelconque"
          .Send
    End With


End
Exit Sub

End Sub