excel - 如何在选择中提取特定单元格的对应值？

Question

我从 Excel 工作簿中选择数据并发送到 Outlook。

我需要更新下面的 VBA 代码以提取与我的选择相对应的列（F、G、H）中特定单元格的值，以放入电子邮件主题。

例如：如果选择是F3,G3,H3输出应该是North,RMDN,G277

工作表数据

Sub Send_Selections_To_OutlookEmail()

    Dim objSelection As Excel.Range
    Dim objTempWorkbook As Excel.Workbook
    Dim objTempWorksheet As Excel.Worksheet
    Dim strTempHTMLFile As String
    Dim objTempHTMLFile As Object
    Dim objFileSystem As Object
    Dim objTextStream As Object
    Dim objOutlookApp As Outlook.Application
    Dim objNewEmail As Outlook.MailItem
    Dim Strbody As String

    
    'Set the selection
    Set objSelection = Nothing
    Set objSelection = Selection.SpecialCells(xlCellTypeVisible)
    Selection.Copy
 
    'Paste the copied selected ranges into a temp worksheet
    Set objTempWorkbook = Excel.Application.Workbooks.Add(1)
    Set objTempWorksheet = objTempWorkbook.Sheets(1)
 
    'Keep the values, column widths and formats in pasting
    With objTempWorksheet.Cells(1)
         .PasteSpecial xlPasteValues
         .PasteSpecial xlPasteColumnWidths
         .PasteSpecial xlPasteFormats
    End With
 
    'Save the temp worksheet as a HTML file
    Set objFileSystem = CreateObject("Scripting.FileSystemObject")
    strTempHTMLFile = objFileSystem.GetSpecialFolder(2).Path & "\Temp for Excel" & Format(Now, "YYYY-MM-DD hh-mm-ss") & ".htm"
    Set objTempHTMLFile = objTempWorkbook.PublishObjects.Add(xlSourceRange, strTempHTMLFile, objTempWorksheet.name, objTempWorksheet.UsedRange.Address)
    objTempHTMLFile.Publish (True)
 
    'Create a new email
    Set objOutlookApp = CreateObject("Outlook.Application")
    Set objNewEmail = objOutlookApp.CreateItem(olMailItem)
     
    'Read the HTML file data and insert into the email body
    objNewEmail.Display
    Set objTextStream = objFileSystem.OpenTextFile(strTempHTMLFile)
    Strbody = "<H5>Eng.</H5>" & "Kindly review the below item to close.<br>"
    
    objNewEmail.HTMLBody = Strbody & "<table align=""left"">" & objTextStream.ReadAll & "<br>" & "<br>" & objNewEmail.HTMLBody
    
    'You can specify the new email recipients, subjects here using the following lines:
    'objNewEmail.To = "[e-mail]"
    objNewEmail.Subject = " PM need review to close @"
    'objNewEmail.Send --> directly send out this email
 
    objTextStream.Close
    objTempWorkbook.Close (False)
    objFileSystem.DeleteFile (strTempHTMLFile)
            
End Sub

标签： excelvba

Answer 1

从选择的第一行返回值。

Option Explicit 

Sub Append_GHIValues_To_Subject()
    
    Dim objOutlookApp As Outlook.Application
    Dim objNewEmail As Outlook.MailItem
    
    Dim rwSel As Range

    Dim GValue As String
    Dim HValue As String
    Dim IValue As String
    
    Set rwSel = Selection
    Debug.Print rwSel.Row
    
    With rwSel.EntireRow
        GValue = .Cells(7).Value
        Debug.Print GValue
        
        HValue = .Cells(8).Value
        Debug.Print HValue
        
        IValue = .Cells(9).Value
        Debug.Print IValue
    End With
    
    'Create a new email
    Set objOutlookApp = CreateObject("Outlook.Application")
    Set objNewEmail = objOutlookApp.CreateItem(olMailItem)

    objNewEmail.Display
    objNewEmail.Subject = " PM need review to close @" & " " & GValue & " " & HValue & " " & IValue
            
End Sub