Lundi 18 Juin 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 : 6
Membres en ligne : 0

 beaulieu 10 semaines
 callaghi 13 semaines
 EMERGENCY 17 semaines
 Charlie76 19 semaines
 joscopp 30 semaines
 JièL 30 semaines
 julbast 30 semaines
 pirobert 31 semaines
 zorro71 55 semaines
 Alphator 73 semaines

Non activés :0

Nombre de visiteurs
depuis le : 12/11/2008

Aujourd'hui:2 350
En ligne :6
Max. en ligne:312
Max. / jour:66 529
Total hier:4 624
Total ce mois:71 000
Total visites:19 963 160
Moyenne/jour:5 697

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 12221 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
R17070 VSTO et les formulaires d'Outlook 2007, R06035 L'archivage ne fonctionne pas, R15040 [VBA] Parcourir tous les dossiers et sous-dossiers., R00090 Noms des serveurs POP, IMAP, SMTP et Webmail des principaux FAI, R17005 Création d'éléments basique, R15000 [VBA] TUTORIEL OULOOK VBA, R08150 Dossier personnel (racine) qui apparait en double, R15600 [VBA] ajouter un dossier contact et le définir en tant que carnet d'adresses, R08150 Dossier personnel (racine) qui apparait en double, R14050 Créer des raccourcis vers des dossiers , R13050 Affecter une tâche à quelqu'un, R07100 Exporter / Importer une liste d'expéditeurs indésirables, R01090 Demander un accusé de réception / lecture, R00020 Mettre Outlook 2002 (et autres) dans le systray, R09040 Supprimer un des noms erronés de la suggestion d'adresses (saisie auto ou saisie semi auto)

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