設置爲Outlook郵件的字段爲Excel單元格值

Question

我借用了Ron De Bruin的代碼，通過電子郵件將選擇內容從工作表發送給電子郵件收件人。

我想從工作表中的一個單元格中指定它發送到的地址，該單元格是由數據輸入（這是另一個表單的查找）選擇的。

如何將to = "email address"替換爲活動工作表中單元格的值？

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

雖然我不確定你試過的是什麼，但我會這麼做。

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

Answer 2

您需要更改下面的代碼行：

.to = "email.address.com" 

下列之一：

.To = ActiveCell.Value 

Answer 3

我已經通過添加下面給出一個答案，現在，

'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 

唯一的問題是我必須將EmailAddressVariable =語句放在以下語句之上;

Set wb = ActiveWorkbook 
Set Dest = Workbooks.Add(xlWBATWorksheet) 

現在它很有魅力 - 感謝Excel論壇上的BellyGas！

我希望這對其他人有用。