2016-02-15 194 views
1

我有一個宏,我想用它來允許用戶粘貼電子郵件中的文本,並自動識別和組織信息以填寫表單。Excel VBA插入InputBox粘貼大文本

我的問題是當談到簡化「粘貼」過程。

我的想法是插入一個InputBox或一個UserForm,用戶將能夠粘貼整個電子郵件文本。雖然它沒有按照我的預期工作。

通常當您在範圍(「A2」)中使用CTRL + V(比方說)時,文本將像電子郵件一樣逐行分開。

是否可以做同樣的事情,但與框提示?還是它只允許插入少量的數據並且只能在一行中?

我的代碼1)

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

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

「這僅複製第一行

同樣的問題與提示用戶窗體 - NameTextBox

任何人都可以,請告知任何其他方式做到這一點?

(我想避免用戶有工作表或做什麼,但粘貼之間切換)提前

非常感謝。

SOLUTION:

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 
+0

對於UserForm,您是否設置了文本框的Multiline屬性?默認值爲false,您應該將其設置爲true。 –

回答

2

你可以使用這樣的事情也許是:

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 
+0

我喜歡這種方法! 問題:將文本粘貼到範圍A2? 我嘗試使用範圍(「A2」)。Value = oDO.GetText - 沒有意義:D 和範圍(「A2」)。PasteSpecial - 粘貼它在一個單獨的塊(如圖像) 。我想弄清楚如何做到這一點,歡迎任何幫助! – Charlie

+0

你還沒有告訴我們你想用剪貼板中的信息做什麼。我向您展示的是一種將信息轉換爲VBA字符串的方式,因此您可以用sTxt = oDO.GetText替換我提供給您的MsgBox,然後根據需要解析代碼中的sTxt內的文本以完成此操作 – jkpieterse

+0

我發現一個解決你的建議:)非常感謝! – Charlie

0

在一個輸入框,CR + LF(vbCrLf)分隔行。在單元格中,LF(vbLf)分隔線條。線分隔符的這種差異可能會導致您的問題。

請嘗試下面的代碼,而不是代碼「我的代碼1」)。

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

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

對不起#Fumu_7,我沒有充分解釋這個問題。 – Charlie