Mardi 14 Août 2018  
Navigation
FAQ Outlook
» Foire Aux Questions «
Recherche
Téléchargements
Forums Outlook
Plan du site
Liens
Login

Les inscriptions sont fermées

Pseudo

Mot de passe

Se souvenir de moi



Mot de passe oublié ? Mot de passe oublié ?
Connexions
Bienvenue à [FAMACLUB]
le 1,414ème membre
Visiteurs en ligne : 3
Membres en ligne : 0

 EMERGENCY 6 semaines
 beaulieu 18 semaines
 callaghi 22 semaines
 Charlie76 27 semaines
 joscopp 38 semaines
 JièL 38 semaines
 julbast 39 semaines
 pirobert 39 semaines
 zorro71 63 semaines
 Alphator 81 semaines

Non activés :0

Nombre de visiteurs
depuis le : 12/11/2008

Aujourd'hui:1 843
En ligne :3
Max. en ligne:312
Max. / jour:66 529
Total hier:2 700
Total ce mois:39 627
Total visites:20 202 221
Moyenne/jour:5 673

Dernières 24h

























Publicité ; elle permet de financer le site
Navigation parmi les catégories/articles
« Catégorie     Q15000 Macros - VBA (41)  Catégorie »
[<<]  « Article  Article »  [>>]
R15500 [VBA] Envoyer un fichier OFFICE par mail
Permet d'envoyer le document actif "OFFICE" (Word, Excel, Powerpoint) en tant que pièce jointe sans alerte de sécurité.

Ci dessous une tite macro à mettre dans n'importe quel programme office(enfin presque).

il faut référencer "Microsoft CDO for Windows 2000 Library"

et il faut que la macro ne soit pas dans le fichier à envoyer.

Pour Access on ne peut pas envoyer la base active avec cette méthode car il faut la fermer et donc plus de code, il doit y a voir une solution mais je ne pratique pas le VBA Access.

Pour Publisher c'est presque la même chose je ne sais pas comment on lance une macro se trouvant dans un autre document.

Mais on peut boucler sur tous les documents ouverts et choisir celui à envoyer.

Ici l 'exemple est donné avec des inputbox pour demander les infos d'envoi

C 'est bien sûr mieux avec un Userform.

La macro à lancer est donc GoMail

Pour simplifier il faut que le document ait été enregistré au préalable.

Dans cet exemple pas de pb de sécurité mais le mail est envoyé directement .


 Public Emetteur As String
Public Destinataire As String
Public Sujet As String
Public CorpsBrut As String
Public Fichier As String
 
 
Function SendMailCDO(Sender As String, Receiver As String, _
                     Subject As String, BodyText As String, _
                     Optional BodyHTML As String, _
                     Optional Cc As String, _
                     Optional Bcc As String, _
                     Optional Attach1 As String)
 
    Dim Cdo_Message As New CDO.Message
 
    Set Cdo_Message.Configuration = GetSMTPServerConfig()
 
    With Cdo_Message
        .To = Receiver
        .From = Sender
        .Subject = Subject
        .Cc = Cc
        .Bcc = Bcc
        '.DSNOptions = 2 ' Delivery Status Notification
        'pour indiquer le Corps du Mail en brut.
        .TextBody = BodyText
        'Décommenter pour indiquer le Corps du Mail en HTML.
        '.HTMLBody = BodyHTML
        'Pour envoyer une page WEB en tant que corps du Mail.
        '.CreateMHTMLBody _
         "http://groups.google.com/group/microsoft.public.fr.outlook", _
         CDO.CdoMHTMLFlags.cdoSuppressNone , "", ""
 
        'ou se trouvant sur son pc
        '.CreateMHTMLBody "file:\\C:\INFORMAT\exemples\événements.htm"
 
 
        If Attach1 <> "" Then
            If Len(Dir(Attach1)) > 0 Then
                .AddAttachment (Attach1)
            Else: MsgBox Attach1 & vbCr & "Ce fichier sera ignoré", _
                         , "Fichier à Attacher introuvable !"
            End If
        End If
 
        'Cette commande envoi le Mail
        .Send
    End With
    Set Cdo_Message = Nothing
End Function
 
 
 
Function GetSMTPServerConfig() As Object
 
    Dim Cdo_Config As New CDO.Configuration
    Dim Cdo_Fields As Object
    Set Cdo_Fields = Cdo_Config.Fields
 
    With Cdo_Fields
        .item(cdoSendUsingMethod) = cdoSendUsingPort
        '.Item(cdoSMTPServer) = "smtp.easynet.fr"
        '.Item(cdoSMTPServerPort) = 25
        .Update
    End With
 
    Set GetSMTPServerConfig = Cdo_Config
    Set Cdo_Config = Nothing
    Set Cdo_Fields = Nothing
 
End Function
 
 
Sub gomail()
    MsgBox Application.Name
    Select Case Application.Name
    Case "Microsoft Excel"
        EnvoiClasseur
    Case "Microsoft Word"
        EnvoiDoc
    Case "Microsoft Access"
        'Envoibase
    Case "Microsoft PowerPoint"
        EnvoiPpt
    Case "Microsoft Publisher"
        'EnvoiCompo
    End Select
End Sub
 
Private Sub EnvoiClasseur()
 
    Set FichierXls = Application.ActiveWorkbook
    If FichierXls.Saved = True Then
        Fichier = FichierXls.FullName
        FichierXls.Close
        Emetteur = InputBox("Emetteur ?", "Envoi par Mail", "Emetteur par défault")
        Destinataire = InputBox("Destinataires (séparés par des ;)", _
                                "Envoi par Mail ")
        Sujet = InputBox("Objet du mail ?", "Envoi par Mail", "Test CDO " & _
                                                              Application.Name)
        CorpsBrut = InputBox("Corps du message ?", "Envoi par Mail", _
                             "Lire le fichier joint")
        Call SendMailCDO(Emetteur, Destinataire, Sujet, CorpsBrut, , , , _
                         Fichier)
 
        Workbooks.Open Fichier
        MsgBox "Mail envoyé"
 
    Else
 
        MsgBox "Vous devez enregistrer votre fichier avant de pouvoir l'envoyer" _
             , , "Erreur"
 
    End If
End Sub
Private Sub EnvoiDoc()
 
    Set FichierDoc = Application.ActiveDocument
    If FichierDoc.Saved = True Then
        Fichier = FichierDoc.FullName
        FichierDoc.Close
        Emetteur = InputBox("Emetteur ?", "Envoi par Mail", "Emetteur par défault")
        Destinataire = InputBox("Destinataires (séparés par des ;)", _
                                "Envoi par Mail ")
        Sujet = InputBox("Objet du mail ?", "Envoi par Mail", _
                         "Test CDO " & Application.Name)
 
        CorpsBrut = InputBox("Corps du message ?", "Envoi par Mail", _
                             "Lire le fichier joint")
 
        Call SendMailCDO(Emetteur, Destinataire, Sujet, CorpsBrut, _
           , , , Fichier)
 
        Documents.Open Fichier
        MsgBox "Mail envoyé"
    Else
 
        MsgBox "Vous devez enregistrer votre fichier avant de pouvoir l'envoyer" _
             , , "Erreur"
 
    End If
End Sub
 
 
 
Private Sub EnvoiPpt()
 
    Set FichierPpt = Application.ActivePresentation
    If FichierPpt.Saved = True Then
        Fichier = FichierPpt.FullName
        FichierPpt.Close
        Emetteur = InputBox("Emetteur ?", "Envoi par Mail", "Emetteur par défault")
        Destinataire = InputBox("Destinataires (séparés par des ;)", _
                                "Envoi par Mail ")
        Sujet = InputBox("Objet du mail ?", "Envoi par Mail", "Test CDO " _
                                                            & Application.Name)
 
        CorpsBrut = InputBox("Corps du message ?", "Envoi par Mail", _
                             "Lire le fichier joint")
 
        Call SendMailCDO(Emetteur, Destinataire, Sujet, CorpsBrut, , , , Fichier)
        Presentations.Open Fichier
        MsgBox "Mail envoyé"
 
    Else
        MsgBox "Vous devez enregistrer votre fichier avant de pouvoir l'envoyer" _
             , , "Erreur"
 
    End If
End Sub

Publié par Oliv le vendredi 16 février 2007 15:34 0 Commentaires 12326 Lecture(s) Imprimer
Commentaires
les commentaires sont fermés.
Copyright et partage
Ce site est sous licence Creative Commons.
Vous pouvez utiliser toutes les informations présentent ici, mais il vous est interdit de les reproduire sans citer la source.

Creative Commons License
OUI au partage
NON au « copillage »

Ajouter aux favoris / partager : 
URL :
BBcode :
HTML :
Cliquez ci dessus sur le lien que vous voulez copier et [Ctrl] + [C] ou cliquez sur le bouton [ C ]
Articles similaires
Articles Catégories
R15045 [VBA] Ouvrir l'arborescence des pst contenant une boîte de réception Q15000 Macros - VBA
R15930 [VBA] Création de menu dans outlook Q15000 Macros - VBA
R18040 VBScript: Créer une signature personnalisée par utilisateur sous Outlook 2003/2007 Q18000 Outlook et Exchange
R15380 [VBA] Envoi via VBA : suppression de la confirmation d'envoi Q15000 Macros - VBA
R15280 [VBA] Exporter un mail et l'ouvrir dans IE avec ses images Q15000 Macros - VBA
Nuage de tags
R15910 [VBA] Executer une macro à heure FIXE ou selon une période., R04060 Supprimer les pièces jointes d'un message, R04010 Insérer une image dans un message, R15410 [VBA] Remplacer dans les Contacts l'envoi au format RTF, R01150 Afficher un compte Hotmail avec Outlook 2000 et suivant, R17060 Remplacer les formulaires par défaut, R06090 Appliquer une règle aux messages existants, R06090 Appliquer une règle aux messages existants, R05070 Imprimer les noms des pièces jointes aux messages en HTML, R01030 Afficher des colonnes d'informations importantes sur les messages, R20120 Configurer un compte IMAP pour Outlook 2007, R17010 Impossible d'exporter les données de champs personnalisés, R17040 Envoyer un e-mail depuis un formulaire de rendez-vous, R08010 Débloquer la boite d'envoi, R05070 Imprimer les noms des pièces jointes aux messages en HTML

aucun Crack, CrackZ, no-CD, DownloadZ, TelechargementZ, Serial, Numéro de série, N0 de série, Serialz ni Keygen pour Outlook sur ce site.

Blague aléatoire
Publicité
Météo Marseille
[/\] Copyright JièL / Jean-Louis Goubert © 2003-2009 [/\]