Intégration adresse email Excel ==> Outlook

Intégration adresse email Excel ==> Outlook - VB/VBA/VBS - Programmation

Marsh Posté le 01-06-2011 à 14:48:59    

Bonjour à tous,
 
Je cherche à créer une macro pour mon boulot qui me permetterais de :  
 

  • créer un e-mail sous outlook,  
  • créer une inputbox demandant un critère de recherche d'un fournisseur
  • d'aller chercher dans un fichier xls prédéterminé le critère de recherche préalablement renseigné
  • prendre l'adresse email correspondate sur la ligne  
  • et l'intégrer en tant que destinataire du message
  • demander confirmation de l'envoie du message
  • envoyer le message


Alors, j'ai déjà plancher un peu la dessus et voila ce que j'ai :
 

Code :
  1. Sub Test()
  3. 'On Error GoTo GetAttachments_err
  5. Dim Oui_Non As Boolean
  6. Dim Resp As VbMsgBoxResult
  7. Oui_Non = MsgBox("Voulez-vous exécutez cette macro ?", vbYesNo, "Lancement" )
  8. If Oui_Non = vbNo Then
  9. Resp = MsgBox("", vbOKOnly)
  10. Exit Sub
  11. 'Erreur ici il ne veut pas arreter la macro quand je clique sur non
  12. End If
  14. Dim DA As String
  15. DA = InputBox("Entrez le numéro de la DA", "Demande d'Achat" )
  17. Dim AO As String
  18. AO = InputBox("Entrez le numéro d'Appel d'Offre", "Appel d'Offre", "600007" )
  20. Dim Art As String
  21. Art = InputBox("Entrez le numéro d'Article", "Article", "FR-" )
  23. Dim Aujourdhui As Date
  25. Dim Nb_Article As Byte
  26. Nb_Article = InputBox("Combien d'article dans cet e-mail ?", "Nombre Article", "1" )
  28. Dim myItem As Outlook.MailItem
  30. Dim Chemin As String
  31. Chemin = "J:\userdata\Appel d'Offre\Appel d'Offre " & AO & ".pdf"
  33. Dim Fournisseur As String
  34. Fournisseur = InputBox("Quel est le numéro/nom de votre fournisseur ?", "Fournisseur" )
  36. Dim Quant As String
  37. Quant = InputBox("Quelle quantité ?" )
  38.  
  39. Dim msn As VbMsgBoxResult
  40.  
  41. Dim Msg As String
  42.  
  43.     Dim olMail As Outlook.MailItem
  44.     Dim olApp As Outlook.Application
  45.     Dim objMail As Outlook.MailItem
  46.     Set olApp = Outlook.Application
  47.     Set objMail = olApp.CreateItem(olMailItem)
  48.    
  49.     'objMessage.Subject = "DA N°" & DA & "RFQ M.A.N pour"
  50.            
  51.     '------------------------------------------------ Début de la recherche excel
  52. Dim xlApp As Object ' Excel.Application
  53. Dim xlWkb As Object ' Excel.Workbook
  55. Set xlApp = GetObject("J:\userdata\Contact Outlook.xls" )
  56. Set xlWkb = ActiveSheet
  58. Dim cellule1 As Range
  59. Dim ligne As Integer
  60. Dim col As Integer
  61. Dim Email As String
  62. Dim cellule2 As String
  64. Set cellule1 = Range(A1, G150).Find("Fournisseur", lookat:=xlPart) 'il me dit que la méthode range de l'objet global a échoué'
  66. If celluletrouvee Is Nothing Then
  67. MsgBox ("pas trouvé" )
  68. Else
  69. ligne = celluletrouvee.Row
  70. col = "G"
  71. MsgBox ("trouvé : ligne = " & ligne & " , colonne = " & col)
  72. cellule2 = ActiveSheet.Range(ligne & col).Value
  73. End If
  74. '------------------------------------------------ Début de l'intégration du texte dans le message
  75.            
  76.     Set objMessage.To = "cellule2" '"Fournisseur"
  77.  
  78.     Msg = "Bonjour," & vbCrLf & "Veuillez SVP nous remettre les prix quantitatifs et les délais pour :" _
  79.     & vbCrLf & vbCrLf & vbCrLf & vbCrLf & "Quantite = " & Quant & vbCrLf & vbCrLf & "Article = " & Art & vbCrLf & vbCrLf & "AO = " & AO _
  80.     & vbCrLf & vbCrLf & "Merci de nous répondre dans les plus brefs délais" _
  81.     & vbCrLf & vbCrLf & "Cordialement, / Best Regards," _
  82.     & vbCrLf & "Thibault MAGRE" & vbCrLf & "Service Achats / Purchasing" _
  83.     & vbCrLf & "XX France SAS" & vbCrLf & "+33 (0)2 40 XX XX XX."
  84.              
  85.   msm = MsgBox("Voulez vous envoyer ce message", vbInformation + vbYesNo)
  87. If msn = vbYes Then
  88.     sendMailMessage = "Ok"
  89. Else
  90.     Exit Sub
  91. End If


 
Voila ce serait super si vous pouviez me donner un coup de main pour que cela fonctionne bien j'ai des connaissances de bases en VBA/VBS (j'ai uniquement appris sur internet il y a une semaine.
 
Merci d'avance pour toute aide de votre part

Reply

Marsh Posté le 01-06-2011 à 14:48:59   

Reply

Marsh Posté le 02-06-2011 à 21:30:41    

Bonjour,
 
Tu as défini oui_non comme un  boolean, ca implique qu'il prend la valeur True ou false.
Toi tu test "If Oui_Non = vbNo Then"
 
Au delà de ca regarde dans l'aide, la fonction Msgbox renvoie un integer =6 pour VbYes et =7 pour VbNo
C'est donc  
dim Oui_Non as integer
If Oui_non=7 then
 
Pour le 2eme c surement que l’application ne sait pas à quoi appartient ton range:

Citation :

  Dim xlApp As Object ' Excel.Application
   Dim xlWkb As Object ' Excel.Workbook
   Set xlApp = GetObject("J:\userdata\Contact Outlook.xls" )
   Set xlWkb = ActiveSheet
    Dim xlWkb as excel.workbook
    set xlWkb=workbooks.open(("J:\userdata\Contact Outlook.xls" )
    Dim cellule1 As Range
    Dim ligne As Integer
    Dim col As Integer
    Dim Email As String
    Dim cellule2 As String
   Set cellule1 = Range(A1, G150).Find("Fournisseur", lookat:=xlPart) 'il me dit que la méthode range de l'objet global a échoué'
Set cellule1 = xlWkb.Worksheets("Nom de ta feuille" ).Range(A1, G150).Find("Fournisseur", lookat:=xlPart)


 
Et sans les "" Sur Fournisseur sinon tu recherche le string "Fournisseur" au lieu de ta variable Fournisseur
 
Edit: C'est tout simplement ton range qui est mauvais en fait Range("A1:G150" ) au lieu de Range(A1, G150)


Message édité par tarteflambee le 02-06-2011 à 21:43:28
Reply

Marsh Posté le 06-06-2011 à 11:47:02    

Merci pour ton aide je commence à mieux comprendre comment tout cela s'organise.
 
Seconde étape :  
 

  • je souhaite que excel intégre la valeur de la cellule (ligne de la cellule trouvée, colonne présélectionnée par moi) dans la variable cellule2
  • je souhaite que si excel ne trouve rien dans mon "range", il affiche une box 'rien trouvé" "voulez vous relancer une recherche avec d'autres critères ?" et qu'il boucle jusqu'à ce que la réponse à la box soit non. S'il trouve quelque chose entretemps, il sort de la boucle et continue :
  • En demandant si l'adresse sélectionnée (cellule 2) est bien celle que l'on souhaite utiliser, si oui ontinue, si non retourne à : "voulez vous relancer une recherche, etc.."


Voici mon code :
 

Code :
  1. Dim xlApp As Object ' Excel.Application
  2. Dim xlWkb As Excel.Workbook
  4. Set xlWkb = Workbooks.Open("J:\userdata\Contact Outlook.xls" )
  6. Dim cellule1 As Range
  7. Dim ligne As Integer
  8. Dim col As String
  9. Dim Email As String
  10. Dim cellule2 As String
  11. Dim Resp2 As Integer
  12. Dim Resp3 As Integer
  14. Set cellule1 = xlWkb.Worksheets("Contacts" ).Range("A1 : G150" ).Find(Fournisseur, lookat:=xlPart)
  16. Do
  17. If cellule1 Is Nothing Then
  18. Resp2 = MsgBox("Pas d'adresse e-mail existante pour ce fournisseur" & "Voulez-vous utilisez un autre critère de recherche ?", vbYesNo)
  19. If Resp2 = 6 Then
  20. Fournisseur = InputBox("Quel est le numéro/nom de votre fournisseur ?", "Fournisseur" )
  21. Set cellule1 = xlWkb.Worksheets("Contacts" ).Range("A1 : G150" ).Find(Fournisseur, lookat:=xlPart)
  22. Loop Until Resp2 = 6 'Il me précise boucle sans Do, alors quye j'ai mon DO juste au dessus ?????
  24. Else: Exit Do
  26. End If
  28. Else
  29. ligne = cellule1.Row
  30. col = "G"
  31. Resp3 = MsgBox("Cette adresse e-mail :" & Application.ActiveSheet.Cells(ligne, col).Value & "?", vbYesNo)
  32. If Resp3 = 7 Then
  33. Loop Until Resp3 = 6
  35. cellule2 = Application.ActiveSheet.Cells(ligne, col).Value
  36. End If


 
J'espere que ces explications suffirons et encore merci à tarteflambee pour ton aide

Reply

Marsh Posté le 07-06-2011 à 22:54:03    

[:psychokwak]

 

tu ne peux pas entrelacer tes if/end if et do/Loop until comme ca.
Il te dit sans "Loop Until" sans do parce que tu est dans la derniere structure conditionnelle ouverte (le if ligne 19)

 

J'ai pas le courage de corriger ligne par ligne ta macro  :whistle:

 

Mais je pense que tu dois faire un truc du genre:

Citation :

   Dim xlApp As Object ' Excel.Application
    Dim xlWkb As Excel.Workbook
    Set xlWkb = ThisWorkbook
   
    Dim cellule1 As Range
    Dim ligne As Integer
    Dim col As Integer
    Dim Email As String
    Dim cellule2 As String
    Dim Resp2 As Integer
    Dim Resp3 As Integer
   
   
    Do
       Do
            Set cellule1 = xlWkb.Worksheets("Contacts" ).Range("A1 : G150" ).Find(fournisseur, lookat:=xlPart)
            If cellule1 Is Nothing Then
                Resp2 = MsgBox("Pas d'adresse e-mail existante pour ce fournisseur" & "Voulez-vous utilisez un autre critère de recherche ?", vbYesNo)
                If Resp2 = 6 Then
                    fournisseur = InputBox("Quel est le numéro/nom de votre fournisseur ?", "Fournisseur" )
                End If
            End If
        Loop Until Not (cellule1 Is Nothing)
       
        ligne = cellule1.Row
        col = 7
       
        Resp3 = MsgBox("Cette adresse e-mail :" & Application.ActiveSheet.Cells(ligne, col).Value & "?", vbYesNo)
   Loop Until Resp3 = 6
   
    cellule2 = Application.ActiveSheet.Cells(ligne, col).Value

 

J'ai mis des couleurs pour les début fin de boucle/condition. Utilise l'indentation pour y voir + clair.
Et quand tu utilise cells(ligne,col) ligne  et col sont des nombres.


Message édité par tarteflambee le 07-06-2011 à 22:58:14
Reply

Marsh Posté le 14-06-2011 à 09:09:18    

Salut Tarteflambée,
 
Merci de ta réponse effectivement sans mes entrelacements tout amrche mieux. Je pens que je vais réussir à faire ma macro ^_^
 
En tout cas merci encore du temps que tu as pris pour me répondre et à bientôt (j'espère pas trop vite car cela signifie que je suis encore bloqué)
 
Bonne journée

Reply

Marsh Posté le 20-06-2011 à 15:52:27    

Salut à tous,
 
Voila depuis la dernière fois j'ai aps mal avancé et ma macro fonctionne plutôt pas mal.
 
Cependant j'aimerias encore l'améliorer un peu et je souhaiterais savoir 3 choses :
 

  • Peux-t-on aller chercher dans un documents (ici Excel) sans devoir l'ouvrir (ce qui est incroyablement long) et pouvoir bien ler fermer à la fin car il semble qu'avec la manip :"xlWkb.Close" par exemple il reste plus ou moins en mémoire. J'ai trouvé des aides sur ce sujet mais les réponses sont incroyablement compliquées et je n'ai pas l'impression de pouvoir intégrer leur bout de code complexe à ma macro facilement


  • Je souhaiterais que lors de la finalisation de mon e-mail, il puisse m'ouvrir une boite montrant les résultats d'une recherche par une variable renseignée plutôt. Je m'explique : je veux qu'a la fin il m'ouvre une boite comme quand on clique sur ajouter une pièce jointe où l'on peut choisir plusieurs fichier (ici des .pdf) mais que cette boite ne me montre que les résultats d'une recherche précise dans un dossier précis. Par exemple si je rentre comme varaible plus tot "Toto", à la fin je voudrais voir aparaitre les seul document pdf contenant le terme "toto" qui sont situés dans le dossier C:\Toto documents. et je voudrais pouvoir choisir parmis ces document sceux que j'ajoute et ceux que je n'ajoute pas avec un simple ctrl + clic.


Pour le moment j'ai essayer de lui demander de chercher ces documents par date et de les ajotuer, cependant cette recherche semble marcher trop bien et il me prend uniquement le plus récent des documents sans m'ajotuer les précédent. Dans ce code je n'affiche pas de boite de choix mais ce serait un plus si possible.
 

  • J'ai intégrer un bout de code en html dans mon code VB et je n'arrive pas à faire que la taille de police soit égale à 11, en sélectionnant size = 3 il me donne 12, et il n'intégère pas la taille 3.5 XD


Merci d'avance pour votre aide
 

Code :
  1. Set OlApp = New Outlook.Application
  2. Set OlItem = OlApp.CreateItem(olMailItem)
  4. With OlItem
  5.         .To = "xxxx.azrertr@mertn.eu"
  6.         .CC = "azerty.uiop@mertn.eu"
  8. AO = InputBox("Entrez le numéro d'Appel d'Offre", "Appel d'Offre", "600007" )
  10. 'Dim Art As String
  12. 'Art = InputBox("Entrez le numéro d'Article", "Article", "FR-" )
  14. Chemin = "J:\userdata\Appel d'Offre\Appel d'Offre " & AO & ".pdf"
  16. If Not AO = "600007xxxx" Then
  17. .Attachments.Add (Chemin)
  19. Resp5 = MsgBox("Y-a-t'il un/des plan(s) à ajouter?", vbYesNo)
  20. If Resp5 = 6 Then
  21. MyPath2 = "J:\userdata\Appel d'Offre"
  22. MyPath3 = "Plan N°* (" & AO & "*"
  24. PointK:
  26.     If Right(MyPath2, 1) <> "\" Then MyPath2 = MyPath2 & "\"
  27.   End If
  28.  
  29.     MyFile2 = Dir(MyPath2 & MyPath3)
  30.    
  31.     If MyFile2 = "" Then
  32.     MyPath2 = InputBox("Impossible de trouver le fichier correspondant" & vbCrLf & "Veuillez entrer un nouveau chemin pour trouver votre fichier" & vbCrLf & _
  33.     "Sous cette forme : Lecteur:\Dossier Parent\Dossier Contenant les Fichiers" )
  34.     GoTo PointK:
  35.     End If
  36.        
  37.     Do While Len(MyFile2) > 0
  38.         If FileDateTime(MyPath2 & MyFile2) > MyDate2 Then
  39.             MyCurrFile2 = MyFile2     
  40. End If
  41.         MyFile2 = Dir2
  42.     .Attachments.Add (MyPath2( & MyCurrFile2)
  43. Loop
  44. End If
  46.         .Display
  47.         .Save
  48.        
  49.      End With


 
Et voila la partie avec la html :
 

Code :
  1. Corps1 = "<html><font face=Calibri size = [#ff0000]11.0pt> Bonjour, <br /><br /> Veuillez SVP nous remettre <b><u><font color=red> les prix quantitatifs</b></u></font> et les d&eacute;lais pour :</font></html>"
  3. Corps2 = "<html><font face=Calibri size = 11.0pt><br />" & Designation(Nb_Article) & "<br /><br /><br /><b><u><font color=red> Quantit&eacute; = " & Quant(Nb_Article) & "</b></u></font><br /><br /> Article = " & Art(Nb_Article) & "<br /><br /> AO = " & AO & "</font></html>"


 

Reply

Marsh Posté le 27-06-2011 à 12:43:31    

Bonjour à tous,
 
Personne pour me donner un p'tit coup de main ?

Reply

Marsh Posté le 01-07-2011 à 14:06:26    

Salut tout le monde,
 
Bon j'ai pas mal avancé sur ma macro elle fonctionne mais a encore quelque ratés :
 
Je n'arrive toujours pas a faire que la taille de police sous HTML soit de 11 et pas de 12.
 
Je n'arrive tjs pas à joindre mes pdf
 
Bon cependant je suis partis sur une étape d'enregistrement des activités qui passe par l'écriture dans un fichier excel de donnée utilisées pour écrire l'e-mail :
 

Code :
  1. Dim CelluleZ As Range
  3. '//Change the path to your folder, accordingly
  4. Livre_Compte = "H:\Elements Macro\DA traitées.xls"
  6. PointR:
  8. Set wkbEnd = Workbooks.Open(Livre_Compte)
  10. 'If wkbEnd = "" Then
  11. 'Livre_Compte = InputBox("Chemin incorrect,quel est le chemin du Livre de Compte des DA traitées ?" _
  12. & vbCrLf & "Veuillez entrer un chemin de ce type : H:\Dossier\Nom du fichier.xls", "Location du Livre de Compte", "H:\Elements Macro\DA traitée.xls" )
  13. 'If Livre_Compte = "" Then Exit Sub
  14. 'GoTo PointR:
  15. 'End If
  17. X = 1
  18. i = 1
  20.     For i = 1 To Nb_Article
  22. Set CelluleZ = wkbEnd.Worksheets("Feuil1" ).Range("B2 : B250" ).Find("", LookAt:=xlPart)
  23.     Cells(CelluleZ.Row, 2).FormulaR1C1 = Art(X)
  24.     Cells(CelluleZ.Row, 1).FormulaR1C1 = DA(X)
  25.     Cells(CelluleZ.Row, 3).FormulaR1C1 = Designation(X)
  26.     Cells(CelluleZ.Row, 4).FormulaR1C1 = Quant(X)
  27.     Cells(CelluleZ.Row, 5).FormulaR1C1 = cellule2
  28.     Cells(CelluleZ.Row, 6).FormulaR1C1 = AO
  29.     Cells(CelluleZ.Row, 7).FormulaR1C1 = "=AUJOURDHUI()"
  30.    
  31.             X = X + 1
  32.     Next
  33.        
  34. wkbEnd.Save
  35. wkbEnd.Close


 
Cependant, bien que le chemin soit correct, il n'arrive pas à m'ouvrir le documents où quand il l'ouvre il n'iscrit rien dedans, enfin rbef ca ne fonctionne pas.
 
QUelque explications sur cette tentative de macro :
Je souhaite qu'à la fin de la rédaction de mon e-mail, il aille inscrire diverses données dans un fichier excel situé sous H:\Elements Macro et qui s'appel DA Traitées.xls
Ces données sont des valeurs de variables préalablement utilisées dans ma macro. La macro doit chercher dans une colonne spécifiée (ici la B) la première case vide, inscrire la valeur du numéro d'article (Art(X)) et ensuite utiliser la valeur de la ligne de cette case pour aller écrire tout au long de la ligne les infos dont il dispose. Si j'ai fait quelque chose d'aussi tortueux c'est parceque toute els informations ne sont pas toujours rentrées dans chacune des lignes et je ne souhaite pas qu'il décalle les infos.
 
Voila j'espère avoir été plutot clair si ce n'est pas le cas je répondrais à n'importe laquelle de vos questions ou demandes.
 
Merci d'avance

Reply

Sujets relatifs:

Leave a Replay

Make sure you enter the(*)required information where indicate.HTML code is not allowed