Excel VBA Insert InputBox для вставки большого текста

Question

У меня есть макрос, который я хочу использовать, чтобы позволить пользователям вставлять текст из электронной почты и автоматически распознавать и упорядочивать информацию для заполнения форм.

Моя проблема заключается в том, чтобы сделать простой процесс «вставки».

Моей идеей было вставить InputBox или UserForm, где пользователь сможет вставить весь текст электронной почты. Хотя это не сработало, как я ожидал.

Обычно, когда вы используете CTRL + V (допустим) в диапазоне («A2»), текст будет разделяться по строкам, как в письме.

Можно ли сделать то же самое, но с полем подсказки? Или это позволяет только вставлять несколько бит данных и только в 1 строку?

Мой код 1)

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

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

«Это только копирует первые строки

Тот же вопрос с Prompt UserForm - 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

В InputBox, CR + LF (vbCrLf) отделяет линии. В ячейке LF (vbLf) разделяет линии. Это различие разделителей строк может вызвать вашу проблему.

Попробуйте использовать следующий код вместо кода «Мой код 1» ».

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

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