Vendredi 28 Juillet 2017  
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 : 1
Membres en ligne : 0

 EMERGENCY 2 jours
 callaghi 1 semaine
 JièL 4 semaines
 zorro71 8 semaines
 Alphator 26 semaines
 ande 32 semaines
 Oliv 34 semaines
 cubitus 38 semaines
 angel 48 semaines
 Quartzkyte 57 semaines

Non activés :0

Nombre de visiteurs
depuis le : 12/11/2008

Aujourd'hui:696
En ligne :1
Max. en ligne:312
Max. / jour:66 529
Total hier:5 053
Total ce mois:149 206
Total visites:17 972 829
Moyenne/jour:5 654

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 11594 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
R14060 Gérer vos Notes, R12055 Planifier une réunion, R99030 Faut deviner ?, R99470 Ca va mieux ?, R08210 Message d'erreur : Le client de courrier électronique par défaut n'est pas correctement installé, R17030 Pourquoi les données saisies dans un formulaire perso ne sont elles pas transmises / enregistrées ?, R18040 VBScript: Créer une signature personnalisée par utilisateur sous Outlook 2003/2007, R05045 Imprimer la partie utile d'un message (Outlook 2007 et autres), R04040 Imprimer directement une pièce jointe, R15210 [VBA] Déplacer le contenu d'un dossier vers un pst., R12055 Planifier une réunion, R09020 Comment fonctionne le complément automatique de la saisie des adresses (saisie auto ou saisie semi auto), R05050 Imprimer des « Contacts », R99210 Y'a pas que les ordis qui rament, R04020 Insérer un élément d'Outlook dans un message

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 [/\]