Mardi 19 Septembre 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 : 9
Membres en ligne : 0

 EMERGENCY 8 semaines
 callaghi 9 semaines
 JièL 11 semaines
 zorro71 16 semaines
 Alphator 34 semaines
 ande 40 semaines
 Oliv 42 semaines
 cubitus 45 semaines
 angel 55 semaines
 Quartzkyte 64 semaines

Non activés :0

Nombre de visiteurs
depuis le : 12/11/2008

Aujourd'hui:2 720
En ligne :9
Max. en ligne:312
Max. / jour:66 529
Total hier:5 222
Total ce mois:99 328
Total visites:18 297 921
Moyenne/jour:5 661

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 11706 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
R09160 Afficher ses contacts dans un ordre différent, R15040 [VBA] Parcourir tous les dossiers et sous-dossiers., R15420 [VBA] Trouver une adresse Email dans les Contacts, R15310 [VBA] Limiter l'envoi selon la taille, R11090 Récupérer des messages effacés, R05040 Imprimer la partie utile d'un message, R08060 Recréer un profil, R01110 Créer un modèle de message (pas un papier peint), R99030 Faut deviner ?, R11060 Restaurer le carnet d'adresses personnel (.PAB), R02020 Envoyer / recevoir automatiquement, R01070 Changer définitivement l'adresse de retour d'un compte, R07120 Interdire l'accès au paramétrage des comptes de messagerie et de carnet d'adresses, R12060 Répondre à une invitation, R03110 Déplacer les messages lors de l'envoi

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