2017-03-20 10 views
-2

Ron De Bruinからコードを借用して、ワークシートの選択を電子メール受信者に電子メールで送信しました。OutlookメールのExcelセル値にフィールドを設定する

データ入力(別のシートからのvlookup)によって選択された、ワークシート内のセルから送信するアドレスを指定します。

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 

答えて

0

私があなたが試したことはよく分かりませんが、これは私がそれについてどうやって行くかです。

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

次のコード行に変更する必要があります。以下のいずれかに

.to = "email.address.com" 

を:

.To = ActiveCell.Value 
0

私は次のように追加することで、今、この答えを与えられています。

'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 ForumのBellyGasに感謝します!

私はこれが他人に役立つことを願っています。

関連する問題