Question

我有一个宏，我想用它来允许用户从电子邮件中粘贴文本，并自动识别和整理信息以填写表格。

我的问题在于简化“粘贴”过程。

我的想法是插入一个InputBox或UserForm，用户可以粘贴整个电子邮件文本。虽然它没有像我期待的那样有效。

通常在范围（“A2”）中使用CTRL + V（假设）时，文本将在电子邮件中逐行分割。

是否可以使用方框提示进行相同操作？或者它只允许插入少量数据并且只能在一行中插入？

我的代码1）

EmailText = InputBox("Please insert Email Text Below")

    wsRep.Range("A2").Value = EmailText

'它只复制第一行

与提示用户窗体相同的问题 - NameTextBox

有人可以建议任何其他方式来做吗？

（我希望避免用户必须在工作表之间切换或做任何事情而不是粘贴）

非常感谢提前。

解决方案：

Dim oDO As DataObject
Dim tmpArr As Variant
Dim Cell As Range
Set oDO = New DataObject
'First we get the information from the clipboard
If MsgBox("Please copy the text from the email and then press OK",      vbOKCancel) = vbOK Then
    oDO.GetFromClipboard
'Here we send the ClipBoard text to a new string which will contain all the Information (all in 1 line)
    sTxt = oDO.GetText
    wsRep.Range("A2") = sTxt 'Range is up to you

'Now we can split the email information using the "line break" and this code (found it [here][1])
    Application.Goto Reference:=wsRep.Range("A1") 'I need to move to the worksheet to run this code
'This code split each line using the criteria "break line" in rows
    For Each Cell In wsRep.Range("A2", Range("A2").End(xlDown))
    If InStr(1, Cell, Chr(10)) <> 0 Then
        tmpArr = Split(Cell, Chr(10))

        Cell.EntireRow.Copy
        Cell.Offset(1, 0).Resize(UBound(tmpArr), 1). _
            EntireRow.Insert xlShiftDown

        Cell.Resize(UBound(tmpArr) + 1, 1) = Application.Transpose(tmpArr)
    End If
    Next
    Application.CutCopyMode = False

    End If

Answer 1

你可以使用这样的东西：

Sub ProcessClipboard()
'first step: Go to Tools, references and check "Microsft Forms 2.0 Object library"
    Dim oDO As DataObject
    Set oDO = New DataObject
    If MsgBox("Please copy the text from the email and then press OK", vbOKCancel) = vbOK Then
        oDO.GetFromClipboard
        MsgBox oDO.GetText
    End If
End Sub

Answer 2

在输入框中，CR + LF（vbCrLf）分隔行。在单元格中，LF（vbLf）分隔线条。线分隔符的这种差异可能会导致您的问题。

尝试使用以下代码而不是代码“我的代码1”。

EmailText = InputBox("Please insert Email Text Below")

wsRep.Range("A2").Value = Replace(EmailText, vbCrLf, vbLf)

Excel VBA插入InputBox以粘贴大文本

2 个答案: