Set To Feld in Outlook Mail an Excel Zelle Wert

Question

Ich habe Code von Ron De Bruin geliehen, um eine Auswahl aus einem Arbeitsblatt an einen E-Mail-Empfänger zu senden.

Ich möchte die Adresse angeben, an die es gesendet wird, aus einer Zelle in dem Arbeitsblatt, die von der Dateneingabe (das ist ein vlookup aus einem anderen Blatt) ausgewählt wird.

Wie kann ich den Wert to = "email address" durch einen Wert aus einer Zelle im aktiven Blatt ersetzen?

Sub Mail_Selection() 
    ' Works in Excel 2000, Excel 2002, Excel 2003, Excel 2007, Excel 2010, Outlook 2000, Outlook 2002, Outlook 2003, Outlook 2007, Outlook 2010. 
    Dim Source As Range 
    Dim Dest As Workbook 
    Dim wb As Workbook 
    Dim TempFilePath As String 
    Dim TempFileName As String 
    Dim FileExtStr As String 
    Dim FileFormatNum As Long 
    Dim OutApp As Object 
    Dim OutMail As Object 
    Dim Recip As String 

    Set Source = Nothing 
    On Error Resume Next 
    Set Source = Selection.SpecialCells(xlCellTypeVisible) 
    On Error GoTo 0 

    If Source Is Nothing Then 
     msgBox "The source is not a range or the sheet is protected. " & _ 
       "Please correct and try again.", vbOKOnly 
     Exit Sub 
    End If 

    If ActiveWindow.SelectedSheets.Count > 1 Or _ 
     Selection.Cells.Count = 1 Or _ 
     Selection.Areas.Count > 1 Then 
     msgBox "An Error occurred :" & vbNewLine & vbNewLine & _ 
       "You selected more than one sheet." & vbNewLine & _ 
       "You selected only one cell." & vbNewLine & _ 
       "You selected more than one area." & vbNewLine & vbNewLine & _ 
       "Please correct and try again.", vbOKOnly 
     Exit Sub 
    End If 

    With Application 
     .ScreenUpdating = False 
     .EnableEvents = False 
    End With 

    Set wb = ActiveWorkbook 
    Set Dest = Workbooks.Add(xlWBATWorksheet) 
    Source.Copy 
    With Dest.Sheets(1) 
     .Cells(1).PasteSpecial Paste:=8 
     .Cells(1).PasteSpecial Paste:=xlPasteValues 
     .Cells(1).PasteSpecial Paste:=xlPasteFormats 
     .Cells(1).Select 
     Application.CutCopyMode = False 
    End With 

    TempFilePath = Environ$("temp") & "\" 
    TempFileName = "Selection of " & wb.Name & " " _ 
       & Format(Now, "dd-mmm-yy h-mm-ss") 

    If Val(Application.Version) < 12 Then 
     ' You are using Excel 2000, Excel 2002, Excel 2003, Excel 2007, or Excel 2010. 
     FileExtStr = ".xls": FileFormatNum = -4143 
    Else 
     ' You are using Excel 2000, Excel 2002, Excel 2003, Excel 2007, or Excel 2010. 
     FileExtStr = ".xlsx": FileFormatNum = 51 
    End If 

    Set OutApp = CreateObject("Outlook.Application") 
    Set OutMail = OutApp.CreateItem(0) 


    With Dest 
     .SaveAs TempFilePath & TempFileName & FileExtStr, _ 
       FileFormat:=FileFormatNum 
     On Error Resume Next 
     With OutMail 
      .to = "email.address.com" 
      .CC = "" 
      .BCC = "" 
      .Subject = "This is the Subject line" 
      .Body = "Hi there" 
      .Attachments.Add Dest.FullName 
      ' You can add other files by uncommenting the following statement. 
      '.Attachments.Add ("C:\test.txt") 
      ' In place of the following statement, you can use ".Display" to 
      ' display the e-mail message. 
      .Send 
     End With 
     On Error GoTo 0 
     .Close SaveChanges:=False 
    End With 

    Kill TempFilePath & TempFileName & FileExtStr 

    Set OutMail = Nothing 
    Set OutApp = Nothing 

    With Application 
     .ScreenUpdating = True 
     .EnableEvents = True 
    End With 
End Sub 

Answer 1

Während ich bin mir nicht sicher, was Sie versucht haben, so würde ich darüber gehen.

Dim emailRange as Range 
Set emailRange = 'Insert your range here, not sure what "data inputer" is 
OutMail.to = emailRange.Value 

Answer 2

Sie müssen die folgende Zeile Code ändern:

.to = "email.address.com" 

auf den folgenden:

.To = ActiveCell.Value 

Answer 3

ich eine Antwort auf diesen nun folgenden durch Zugabe gegeben wurde;

'Set the EmailAddressVariable to the value in the approvals worksheet in cell A1 
Dim EmailAddressVariable As String 
EmailAddressVariable = Sheets("Sheet1").Range("A1").Value 
'next point the .to statement to the variable 
.to = EmailAddressVariable 

Der einzige Haken war, dass ich die EmailAddressVariable = Aussage über die folgende Aussage setzen musste;

Jetzt funktioniert es ein Charme - Dank BellyGas auf Excel Forum!

Ich hoffe, dass dies für andere von Nutzen ist.