Choisissez un sujet de courrier électronique dans la list déroulante de la colonne Excel

édité après l'utilisation d'OP de mon code d'origine et d'autres précisions

suit un code de refactorisation complet selon les "règles" suivantes

• Option Explicit statement

  cela vous oblige à déclarer toutes les variables

  mais ce petit travail supplémentaire, mais vous ramène avec beaucoup plus de contrôle sur votre écriture et less de debugging et / ou des efforts de maintenance

• Le principal "mega" code se divise en plusieurs Sous / Funcs

  cela aide à

  • avoir un code plus lisible et plus durable

  • en gardant Userforms et Applications chargés de charger et de décharger les appels loin de n'importe quel code UserForm, qui ne doit s'occuper que de son vrai travail: rassembler des informations

placez-le dans votre module Outlook:

 Option Explicit Sub email_DP2() Dim mailData As Variant mailData = GetMailDataFromExcel("C:\persons.xlsm", _ "Module2.FetchData3", _ "Sheet4", _ "L") If mailData = Empty Then Exit Sub With CreateItem(0) .SentOnBehalfOfName = "" .Importance = olImportanceHigh .To = mailData(1) .Subject = mailData(0) .GetInspector.WordEditor.Range.collapse 1 .Display .HTMLBody = mailData(2) '.Paste 'what are you pasting from? End With End Sub '------------------------------------------------------- ' Excel handling Subs and Funcs '------------------------------------------- Function GetMailDataFromExcel(strFile As Ssortingng, fetchingModule As Ssortingng, strSheet As Ssortingng, colStrng As Ssortingng) As Variant Dim xlApp As Excel.Application Dim closeExcel As Boolean Dim namesRng As Excel.Range Set xlApp = GetExcel(closeExcel) If Not xlApp Is Nothing Then Set namesRng = GetExcelRange(xlApp, strFile, fetchingModule, strSheet, colStrng) 'this will get the names range from given column of given worksheet of given workbook With UserForm14 If namesRng.Count = 1 Then .ComboBox1.AddItem namesRng.Value Else .ComboBox1.List = xlApp.Transpose(namesRng) End If .Show With .ComboBox1 If .ListIndex > -1 Then GetMailDataFromExcel = Array(.Value, _ namesRng.Offset(, 5).Cells(.ListIndex + 1, 1).Value, _ namesRng.Offset(, 6).Cells(.ListIndex + 1, 1).Value) End With End With Unload UserForm14 Set namesRng = Nothing ReleaseExcel xlApp, closeExcel End If End Function Function GetExcelRange(xlApp As Excel.Application, strFile As Ssortingng, fetchingModule As Ssortingng, strSheet As Ssortingng, colStrng As Ssortingng) As Excel.Range With xlApp.Workbooks.Open(strFile, , False, , , , , , , True) xlApp.Run fetchingModule With .Worksheets(strSheet) Set GetExcelRange = .Columns(colStrng).Resize(.Cells(.Rows.Count, colStrng).End(xlUp).Row) End With End With End Function Function GetExcel(closeExcel As Boolean) As Excel.Application On Error Resume Next Set GetExcel = GetObject(, "Excel.Application") If GetExcel Is Nothing Then Set GetExcel = CreateObject("Excel.Application") closeExcel = True End If If GetExcel Is Nothing Then MsgBox "Couldn't instantiate Excel!", vbCritical End If End Function Sub ReleaseExcel(xlApp As Excel.Application, closeExcel As Boolean) If closeExcel Then xlApp.Quit Set xlApp = Nothing End Sub '------------------------------------------------------- 

placez-le dans votre panneau de code UserForm14

 Option Explicit Private Sub btnOK_Click() Me.Hide End Sub Private Sub CancelButton_Click() Me.Hide End Sub Private Sub UserForm_QueryClose(Cancel As Integer, CloseMode As Integer) If CloseMode = vbFormControlMenu Then Cancel = True Me.Hide End If End Sub 

dans ce dernier je

• ajoutée Option Explicit statement

  bien qu'il ne soit pas ssortingctement nécessaire (il n'y a pas d'utilisation de variables, mais "embeddedes"), il s'appuie sur une bonne habitude

• a ajouté un gestionnaire d'events UserForm_QueryClose

  qui gère l'user éventuel en cliquant sur le button "Fermer" de la UserForm

• effacé la déclaration End

  J'ai toujours appris que c'est une mauvaise habitude de l'utiliser et de mieux adhérer aux fonctions Exit Sub / Exit Function (éventuellement avec un mélange approprié de If.. Then.. Else blocks) pour get le même effet sans aucun dommage

Pour connecter votre Outlook à Excel, vous devez d'abord append une reference à "Microsoft Excel XX Object Library" où XX est un numéro de version (Extras-> Références)

Ensuite, créez un formulaire d'user, le mien ressemble à ceci:

Notez que mon combobox comporte 2 colonnes (la première a une largeur de 0, donc invisible)

Ensuite, lorsque vous chargez le formulaire, ajoutez le code pour ouvrir une instance Excel et chargez la combobox avec des valeurs à sélectionner parmi:

 Private Sub UserForm_Initialize() 'Define Excel-Variables Dim xlApp As Excel.Application Dim xlWB As Excel.Workbook Dim xlSheet As Excel.Worksheet 'Create Excel Instance Set xlApp = New Excel.Application 'Make it invisible xlApp.Visible = False 'Open Workbook with Values Set xlWB = xlApp.Workbooks.Open("PATH TO YOUR EXCEL FILE") 'Select the Sheet with Values Set xlSheet = xlWB.Worksheets("sheet1") Dim i As Integer 'Loop through the Values For i = 1 To 30 Step 1 'This Combobox has 2 Columns where 1 is the bound one 'Add RowIndex to the first column(will be used to find the values later) Me.cboTest.AddItem i 'Add the Name to the second Column Me.cboTest.List(Me.cboTest.ListCount - 1, 1) = xlSheet.Cells(i, 1).Value Next i 'Clean up and close Excel Set xlSheet = Nothing xlWB.Close False xlApp.Quit Set xlWB = Nothing Set xlApp = Nothing End Sub 

Ensuite, vous devez append un code au button:

Private Sub cmdSend_Click ()

 'variables for the values we are getting now Dim name As Ssortingng, email As Ssortingng, text As Ssortingng 'more excel variables Dim xlApp As Excel.Application Dim xlWB As Excel.Workbook Dim xlSheet As Excel.Worksheet Set xlApp = New Excel.Application xlApp.Visible = False Set xlWB = xlApp.Workbooks.Open("PATH TO EXCEL FILE") Set xlSheet = xlWB.Worksheets("sheet1") 'access the rowindex from the first column of the combobox 'use it for the Cells() as row 'column may be edited as needed name = xlSheet.Cells(Me.cboTest.List(Me.cboTest.ListIndex, 0), 1).Value email = xlSheet.Cells(Me.cboTest.List(Me.cboTest.ListIndex, 0), 2).Value text = xlSheet.Cells(Me.cboTest.List(Me.cboTest.ListIndex, 0), 3).Value 'excel cleanup Set xlSheet = Nothing xlWB.Close False xlApp.Quit Set xlWB = Nothing Set xlApp = Nothing 'print output to console 'instead of this, write your email Debug.Print "mailto:" & email & " name:" & name & " text: " & text End Sub 

Ensuite, si nous ouvrons le formulaire, nous pouvons choisir parmi les valeurs:

Si nous cliquons ensuite sur le button, il ouvrira excel et obtiendra les valeurs pertinentes de l'élément que nous avons sélectionné.

Output for Name5 ressemble à ceci:

En passant, ma list d'exemples excel ressemble à ceci:

@ user3598756

J'ai configuré votre configuration avec votre code:

code userform14: "

 Private Sub btnOK_Click() Me.Hide End Sub Private Sub CancelButton_Click() Me.Hide End End Sub Private Sub UserForm_Click() End Sub 

et le code de fonction:

  Sub email_DP2() Dim name As Ssortingng, email As Ssortingng, text As Ssortingng Dim OutApp As Object Dim OutMail As Object Dim olInsp As Object Dim oRng As Object Dim StrBdB As Ssortingng Dim xlApp As Object Dim sourceWB As Object Dim sourceWS As Object Set xlApp = CreateObject("Excel.Application") strFile = "C:\persons.xlsm" Set sourceWB = xlApp.Workbooks.Open(strFile, , False, , , , , , , True) Set sourceWH = sourceWB.Worksheets("Sheet4") sourceWH.Application.Run "Module2.FetchData3" Dim pickedName As Ssortingng, emailAddress As Ssortingng, emailText As Ssortingng Dim namesRng As Range With sourceWH '<== change "myWorkbookName" and "Sheet4" to your needs Set namesRng = .Range("L1:L" & .Cells(.Rows.Count, "L").End(xlUp).Row) End With With UserForm14 ' change it to whatever name your actual UserForm has .ComboBox1.List = xlApp.Transpose(namesRng) .Show With ComboBox1 pickedName = .Value emailAddress = namesRng.Offset(, 5).Cells(.ListIndex + 1, 1).Value emailText = namesRng.Offset(, 6).Cells(.ListIndex + 1, 1).Value End With End With Unload UserForm14 On Error Resume Next Set OutApp = GetObject(, "Outlook.Application") If Err <> 0 Then Set OutApp = CreateObject("Outlook.Application") On Error GoTo 0 Set OutMail = OutApp.CreateItem(0) With OutMail OutMail.SentOnBehalfOfName = "" .Importance = olImportanceHigh .To = emailAddress .Subject = pickedName Set olInsp = .GetInspector Set wdDoc = olInsp.WordEditor Set oRng = wdDoc.Range oRng.collapse 1 .Display OutMail.HTMLBody = emailText oRng.Paste End With Set OutMail = Nothing Set OutApp = Nothing Set olInsp = Nothing Set wdDoc = Nothing Set oRng = Nothing End Sub 

Il donne l'object requirejs sur la ligne choisie Nom = .Value – si j'élimine la ligne, elle en donnera la même ligne à la ligne de l'adresse emailAddress = namesRng.Offset … J'ai un problème avec With ComboBox1 – si je l'éliminer, il générera un email mais sans le, sujet et text ajouté.