Outlook 이메일 본문 Excel

Question

나는 모든 전자 메일의 본문을 Excel 파일로 출력하는 폴더에 넣으려고합니다.

Dim appExcel As Excel.Application 
Dim wkb As Excel.Workbook 
Dim wks As Excel.Worksheet 
Dim rng As Excel.Range 
Dim strSheet As String 
Dim strPath As String 
Dim intRowCounter As Integer 
Dim intColumnCounter As Integer 
Dim msg As Outlook.MailItem 
Dim nms As Outlook.NameSpace 
Dim fld As Outlook.MAPIFolder 
Dim itm As Object 
strSheet = "Test.xlsm" 
strPath = "C:user\Documents\Action Items\" 
strSheet = strPath & strSheet 
Debug.Print strSheet 
'Select export folder 
Set nms = Application.GetNamespace("MAPI") 
Set fld = nms.PickFolder 

'Open and activate Excel workbook. 
Set appExcel = CreateObject("Excel.Application") 
appExcel.Workbooks.Open (strSheet) 
Set wkb = appExcel.ActiveWorkbook 
Set wks = wkb.Sheets(1) 
wks.Activate 
appExcel.Application.Visible = True 
'Copy field items in mail folder. 
For Each itm In fld.Items 
intColumnCounter = 1 
Set msg = itm 
intRowCounter = intRowCounter + 1 
Set rng = wks.Cells(intRowCounter, intColumnCounter) 
rng.Value = msg.Body 
intColumnCounter = intColumnCounter + 1 
Next itm 

문제입니다 내가 복사하는 것처럼 엑셀에서 한 줄을 가지고 전망의 각 행을 할 때 각 메시지는 하나의 세포에 투입되고 있음과 : 아래의 코드는 내가 사용하고있는 것입니다 ctrl + a, ctrl + c, ctrl + v를 사용하여 수동으로 Excel에서 본문을 붙여 넣습니다.

본문을 구문 분석하는 데 Split()을 사용해야하는 것처럼 느껴지지만 그 기능에 대한 경험이 없으며 제대로 작동하지 않는 것 같습니다.

편집 :

나는 아래 사용하여이 문제를 해결 할 수 있었다 :

Sub SplitTextColumn() 

Dim i As Long 
Dim vA As Variant 


[A1].Select 
Range(Selection, Selection.End(xlDown)).Select 
For i = 1 To Selection.Rows.Count 
vA = Split(Selection.Resize(1).Offset(i - 1), vbLf) 
Selection.Offset(i - 1).Resize(1, UBound(vA) + 1).Offset(, 1) = vA 
Next 

[A1].CurrentRegion.Offset(0, 1).Select 
    Selection.Copy 
    Sheets.Add After:=ActiveSheet 
    Selection.PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:= _ 
     False, Transpose:=True 


End Sub 

그리고

Sub MakeOneColumn() 

Dim vaCells As Variant 
Dim vOutput() As Variant 
Dim i As Long, j As Long 
Dim lRow As Long 

If TypeName(Selection) = "Range" Then 
    If Selection.Count > 1 Then 
     If Selection.Count <= Selection.Parent.Rows.Count Then 
      vaCells = Selection.Value 

      ReDim vOutput(1 To UBound(vaCells, 1) * UBound(vaCells, 2), 1 To 1) 

      For j = LBound(vaCells, 2) To UBound(vaCells, 2) 
       For i = LBound(vaCells, 1) To UBound(vaCells, 1) 
        If Len(vaCells(i, j)) > 0 Then 
         lRow = lRow + 1 
         vOutput(lRow, 1) = vaCells(i, j) 
        End If 
       Next i 
      Next j 

      Selection.ClearContents 
      Selection.Cells(1).Resize(lRow).Value = vOutput 
     End If 
    End If 
End If 

Dim c As Range 
Set rng = ActiveSheet.Range("A1:A5000") 
For dblCounter = rng.Cells.Count To 1 Step -1 
    Set c = rng(dblCounter) 
    If c.Value Like "*MEADWESTVACO SUMMARY 856*" Then 
    c.EntireRow.Insert 
End If 
Next dblCounter 

을하지만 엑셀 개체가 같은 느낌하지 않습니다 그 잠수정이 전망 VBA에서 불리는 때 확실히 바르게 언급했다. 나는 그것을 실행할 때마다 정확하게 오류가 발생합니다. 즉, 한 번 실행하면 작동하지만 두 번째로 중단되면 세 번째로 다시 작동합니다. 어떤 제안?

Answer 1

예를 들어 아래의 'SplitEmByLine'함수를 사용하면 ReturnString 및 PrintArray 함수를 명확하게 남겨 두었습니다. 그러나이 함수는 본질적으로 무시할 수 있습니다.

Sub callSplitFunction() 
Dim FileFull As String, a() As String, s As Long 
FileFull = "C:\Users\thomas.preston\Desktop\ThisBookOfMine.txt" 
'The below line calls function 
a = SplitEmByLine(ReturnString(FileFull)) 
PrintArray a 
End Sub 

'*****The below function is what you need***** 
Function SplitEmByLine(ByVal Body As String) As String() 
Dim x As Variant 
x = Split(Body, vbCrLf) 
SplitEmByLine = x 
End Function 


Sub PrintArray(ByRef Arr() As String) 
With Sheets("Sheet1") 
    For i = 0 To UBound(Arr) 
     .Cells(i + 1, 1).Value = Arr(i) 
    Next i 
End With 
End Sub 


Function ReturnString(FilePath As String) As String 
    Dim TextFile As Integer 
    Dim FileContent As String 

    TextFile = FreeFile 
    Open FilePath For Input As TextFile 
    FileContent = Input(LOF(TextFile), TextFile) 
    Close TextFile 
    ReturnString = FileContent 
End Function