Automatiser l'envoi d'une feuille

Question

Dans la série les boulets d'incrustent : L'outil Excel sur lequel je travaille actuellement doit être utilisé sur 3 sites géographiques et je dois récupérer certaines données pour les tableaux de synthèse. Afin de sécuriser la collecte des résultats statistiques, je souhaiterais créer une fonction qui envoie automatiquement une page sur une adresse messagerie. Cet envoi doit pouvoir se faire dans un premier temps à chaque calcul F9 de la page et quand le système sera bien rodé tous les 15 et dernier jours du mois. J'ai essayé d'affecter une macro à un bouton dans la page en question mais apparamment la programmation automatique ne reconnait pas ou ne mémorise pas la ligne de menu envoyer vers. En résumé, ma question est : Comment commander l'ouverture d'Outlook en programmation de macro automatique ? Petite précision, quand on parle d'installer du code, je ne sais même pas où ni comment Par avance merci...

Invité · Answer

Pour envoyer la feuille active par E-mail (Code de Kiki29 à mettre dans un module standard) Option Explicit Sub Tst() Dim Sourcewb As Workbook Dim Destwb As Workbook Dim Temp As String Dim CdoMessage As Object Dim Fichier As String Set Sourcewb = ActiveWorkbook ActiveSheet.Copy Set Destwb = ActiveWorkbook Temp = ThisWorkbook.Path &amp; Application.PathSeparator &amp; "Toto.xls" With Application .ScreenUpdating = False .DisplayAlerts = False End With Destwb.SaveAs Temp Fichier = Destwb.Path &amp; Application.PathSeparator &amp; Destwb.Name Destwb.Close Application.DisplayAlerts = True Set CdoMessage = CreateObject("CDO.Message") With CdoMessage .Subject = "Exemple" .From = "xxxxx@wanadoo.fr" .To = "yyyyy@hotmail.fr" .CC = "" .BCC = "" .TextBody = "Texte dans le corps de message" .AddAttachment Fichier .Send End With Application.ScreenUpdating = True Set CdoMessage = Nothing Kill Fichier End Sub J'ai testé seulement sous Excel 2003 avec Outlook Express 6 Dès que votre problème est résolu, merci de le marquer en tant que &#91;Résolu&#93; grâce à l'utilitaire se trouvant en bas de page, aperçu : Mytå...

Perigord · Answer

Le code de base:

J'y suis parvenue comme suis:

Private Sub CommandButton1_Click()
'Crée une copie de la feuille active dans un nouveau classeur.
  Activesheet.select
   With ActiveSheet
    Cells.Select
    Range("X14").Activate
    Selection.Copy
    Workbooks.Add
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
        SkipBlanks:=False, Transpose:=False
   End With
  'Sauvegarde se nouveau classeur sous le nom désiré dans le dossier désiré.
    Application.DisplayAlerts = False
    ActiveWorkbook.SaveAs Filename:= _
        "C:\Program Files\EnvoisEmail.xls", _
        FileFormat:=xlNormal, Password:="", WriteResPassword:="", _
        ReadOnlyRecommended:=False, CreateBackup:=False
  'Ferme se classeur  
        Windows("EnvoisEmail.xls").Close
    Range("A1").Select

Dim Dest, Sujt, Msg As String
Dim TheFile
'Envois se classeur par mail, l'adresse du destinateur est dans la cellule A1
TheFile = "C:\Program Files\EnvoisEmail.xls"
Dest = Range("A1").Text
Sujt = "Le titre de votre mail"
Msg = "Bonjour ," & vbCrLf & vbCrLf & "Voici un test d'envois de email. une piece jointe est censé y être attaché. " & vbCrLf & vbCrLf & "Merci d'avoir pris le temps de lire se test." & vbCrLf & vbCrLf & "L'équipe testun"
Shell "C:\Program Files\Outlook Express\msimn.exe " & _
"/mailurl:mailto:" & Dest & "?subject=" & Sujt & "&Body=" & Msg & ""
SendKeys "%I" & "p" & TheFile & "~" & "%s"

    Application.DisplayAlerts = True

  Application.ScreenUpdating = True

Else
    MsgBox "Aucune fiche ne correspond à la recherche"
End If
End Sub

Invité · Answer

Re le forum Tu n'avais qu'à enlever cette ligne .From = "xxxxx@wanadoo.fr" pour ne pas avoir le destinataire en dur. Mytå...

Perigord · Answer

Le problème avec l'enregistrement sur le bureau est que l'adresse du bureau change tout dépendant de sur qu'elle session l'adresse est ouvert, tant disque program files ne change jamais. Il te faut un dossier qui ne change jamais d'adresse. Tu peux mettre l'adresse par default d'enregistrement d'excel par contre: C:\Documents and Settings\Owner\Application Data\Microsoft\Excel\ (Je crois qu'elle ne change jamais mais c'est a vérifier. Et envoismail n'est pas un répertoire, c'est le nom du fichier .xls créé. envoismail.xls A chaque fois que tu envois se mail, il écrase le fichier en réenregistrant avec le même nom. Pour l'adresse de ton outlook express, je ne peux pas t'aider, normalement elle ne change pas mais ... tu peux utiliser la fonction recherche sur ton ordinateur avec le terme msimn.exe Et pour finir, tu peux supprimer MsgBox "Aucune fiche ne correspond à la recherche" un oublis de ma part, qui sert a ma macro seulement. Voila P.S. Myta, ta commande ne demande pas l'activation d'une référenceVBAproject ...

Invité · Answer

Re le forum Bon, il vient de dire qu'il travaille en réseau, fallait le dire au début ChatNoir. Je déteste travailler pour rien. Je passe la main aux experts Mytå...