Excel VBA获取表单文本填充邮件遇Runtime Error 424对象缺失错误

错误原因 #

运行时错误424是因为代码无法找到指定的文本框对象——不同类型的Excel文本框，VBA的引用方式完全不同，当前代码写法仅适用于用户窗体（UserForm）控件，不适用于工作表上的三种文本框。

针对不同文本框的解决方案 #

1. 表单控件（Form Control）文本框 #

这类控件并非为用户交互输入设计，本身不支持.Value属性读取，会呈现灰色不可用状态，直接放弃使用即可。

2. ActiveX控件文本框 #

这是适合交互输入的类型，修改代码时必须指定控件所在的工作表：

' 修改获取用户输入的代码段
SubjectText = ThisWorkbook.Sheets("Sheet1").SubjectTextBox.Value
GreetingOne = ThisWorkbook.Sheets("Sheet1").GreetingOneTextBox.Value
GreetingTwo = ThisWorkbook.Sheets("Sheet1").GreetingTwoTextBox.Value
BodyText = ThisWorkbook.Sheets("Sheet1").BodyTextBox.Value

额外排查点：

• 右键ActiveX控件→【属性】，确认"名称"栏与代码中的名称完全一致（不要混淆显示的Caption属性）。
• 检查工作表是否被保护，保护状态下ActiveX控件会失效。
• 若控件仍无响应，可尝试重新插入控件，或运行管理员命令修复ActiveX注册：regsvr32.exe C:\Windows\System32\MSCOMCTL.ocx

3. 普通形状文本框（插入→文本框） #

这类是形状对象，需通过Shapes集合引用，代码修改如下：

' 修改获取用户输入的代码段
SubjectText = ThisWorkbook.Sheets("Sheet1").Shapes("SubjectTextBox").TextFrame2.TextRange.Text
GreetingOne = ThisWorkbook.Sheets("Sheet1").Shapes("GreetingOneTextBox").TextFrame2.TextRange.Text
GreetingTwo = ThisWorkbook.Sheets("Sheet1").Shapes("GreetingTwoTextBox").TextFrame2.TextRange.Text
BodyText = ThisWorkbook.Sheets("Sheet1").Shapes("BodyTextBox").TextFrame2.TextRange.Text

注意：右键文本框边框→【设置形状格式】→【大小与属性】，确认形状名称与代码一致。

完整修改后的示例代码（以ActiveX控件为例） #

Sub Create_Emails()
    Dim OutlookApp As Object
    Dim OutlookMail As Object
    Dim RecipientsRange As Range
    Dim RecipientCell As Range
    Dim BodyText As String
    Dim SubjectText As String
    Dim GreetingOne As String
    Dim GreetingTwo As String
    Dim AdditionalText As String
    
    ' Set the range for email addresses (B4:B24)
    Set RecipientsRange = ThisWorkbook.Sheets("Sheet1").Range("B4:B24")   
    
    ' Get user input from ActiveX text boxes (指定工作表)
    SubjectText = ThisWorkbook.Sheets("Sheet1").SubjectTextBox.Value
    GreetingOne = ThisWorkbook.Sheets("Sheet1").GreetingOneTextBox.Value
    GreetingTwo = ThisWorkbook.Sheets("Sheet1").GreetingTwoTextBox.Value
    BodyText = ThisWorkbook.Sheets("Sheet1").BodyTextBox.Value
    
    ' Get additional text from cells C4 to C24
    AdditionalText = Join(Application.Transpose(ThisWorkbook.Sheets("Sheet1").Range("C4:C24").Value), " ")
    
    ' Create an instance of Outlook
    Set OutlookApp = CreateObject("Outlook.Application")
    
    ' Loop through each recipient email address and send an email
    For Each RecipientCell In RecipientsRange
        If RecipientCell.Value <> "" Then ' Check if the cell is not empty
            ' Create a new email
            Set OutlookMail = OutlookApp.CreateItem(0)
            
            ' Set email properties
            With OutlookMail
                .To = RecipientCell.Value
                .Subject = SubjectText
                .Body = GreetingOne & " " & RecipientCell.Value & "," & vbCrLf & vbCrLf & AdditionalText & vbCrLf & vbCrLf & GreetingTwo & vbCrLf & vbCrLf & BodyText
                .Display ' Use .Send instead of .Display to send emails automatically
            End With
            
            ' Release the email object
            Set OutlookMail = Nothing
        End If
    Next RecipientCell
    
    ' Release the Outlook application object
    Set OutlookApp = Nothing
End Sub

内容的提问来源于stack exchange，提问作者Bowman