1
Excel 통합 문서로 선택한 폴더의 전자 메일 제목을 내보내는 코드가 있습니다. 제목의 첫 번째 '공백'다음에 텍스트가 있어야 다른 열 (C 열)으로 내보낼 수 있습니다. 아래는 제목 줄 모양을의 몇 가지 예입니다 : 내가 하나 개의 컬럼에 제목에 최초의 우주 전에 모든 숫자 (또는)를 갖고 싶어Excel에서 제목 줄을 별도의 열로 나누십시오.
" 321-654321 APPROVED With more words to follow "
및
" APR#987-123456 CONTIGENT With More text to follow "
가와 다른 열의 숫자, 첫 번째 공백 다음의 모든 것. 여기
내가 여기Column A - Column B - Column C
XXX-XXXXX - DateOf Email - Status of the incident
내가 현재 사용하고 코드가하고 싶은 출력의 예입니다, 나는 유래에이 매크로를 찾을 생각합니다. 또한, 사용자가 폴더를 선택하지 않고이 매크로가 코드 내부에서 작동하도록 할 폴더를 넣을 수 있습니까?
Sub ExportToExcel()
On Error GoTo ErrHandler
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 = "spreadhsheet.xlsx"
strPath = "C:\MyOutlookMacro\"
strSheet = strPath & strSheet
Debug.Print strSheet
'Select export folder
Set nms = Application.GetNamespace("MAPI")
Set fld = nms.PickFolder
'Handle potential errors with Select Folder dialog box.
If fld Is Nothing Then
MsgBox "There are no mail messages to export", vbOKOnly, "Error"
Exit Sub
ElseIf fld.DefaultItemType <> olMailItem Then
MsgBox "There are no mail messages to export", vbOKOnly, "Error"
Exit Sub
ElseIf fld.Items.Count = 0 Then
MsgBox "There are no mail messages to export", vbOKOnly, "Error"
Exit Sub
End If
'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 + 3
intColumnCounter = intColumnCounter + 1
Set rng = wks.Cells(intRowCounter, intColumnCounter)
rng.Value = msg.Subject
intColumnCounter = intColumnCounter + 1
Set rng = wks.Cells(intRowCounter, intColumnCounter)
rng.Value = msg.SentOn
Next itm
Set appExcel = Nothing
Set wkb = Nothing
Set wks = Nothing
Set rng = Nothing
Set msg = Nothing
Set nms = Nothing
Set fld = Nothing
Set itm = Nothing
Exit Sub
ErrHandler: If Err.Number = 1004 Then
MsgBox strSheet & " doesn't exist", vbOKOnly, "Error"
Else
MsgBox Err.Number & "; Description: ", vbOKOnly, "Error"
End If
Set appExcel = Nothing
Set wkb = Nothing
Set wks = Nothing
Set rng = Nothing
Set msg = Nothing
Set nms = Nothing
Set fld = Nothing
Set itm = Nothing
End Sub
-------------------------------
Sub ExportToExcel()
On Error GoTo ErrHandler
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
Dim Words As String
strSheet = "spreadhsheet.xlsx"
strPath = "C:\MyOutlookMacro\"
strSheet = strPath & strSheet
Debug.Print strSheet
'Select export folder
Set nms = Application.GetNamespace("MAPI")
Set fld = nms.PickFolder
'Set fld = Set fld = myNamespace.GetDefaultFolder(olFolderInbox).Folders("SpreadsheetItems")
'Handle potential errors with Select Folder dialog box.
If fld Is Nothing Then
MsgBox "There are no mail messages to export", vbOKOnly, "Error"
Exit Sub
ElseIf fld.DefaultItemType <> olMailItem Then
MsgBox "There are no mail messages to export", vbOKOnly, "Error"
Exit Sub
ElseIf fld.Items.Count = 0 Then
MsgBox "There are no mail messages to export", vbOKOnly, "Error"
Exit Sub
End If
'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
Words = Split(msg.Subject, " ")
intRowCounter = intRowCounter + 3
intColumnCounter = intColumnCounter + 1
Set rng = wks.Cells(intRowCounter, intColumnCounter)
rng.Value = Words(0)
intColumnCounter = intColumnCounter + 1
Set rng = wks.Cells(intRowCounter, intColumnCounter)
rng.Value = msg.SentOn
intColumnCounter = intColumnCounter + 1
Set rng = wks.Cells(intRowCounter, intColumnCounter)
rng.Value = Words(2)
Next itm
Set appExcel = Nothing
Set wkb = Nothing
Set wks = Nothing
Set rng = Nothing
Set msg = Nothing
Set nms = Nothing
Set fld = Nothing
Set itm = Nothing
Exit Sub
ErrHandler: If Err.Number = 1004 Then
MsgBox strSheet & " doesn't exist", vbOKOnly, "Error"
Else
MsgBox Err.Number & "; Description: ", vbOKOnly, "Error"
End If
Set appExcel = Nothing
Set wkb = Nothing
Set wks = Nothing
Set rng = Nothing
Set msg = Nothing
Set nms = Nothing
Set fld = Nothing
Set itm = Nothing
End Sub
** 내가 컴파일 오류 "받고 있어요 : rng.Value @ 예상 배열 = 단어 (0) **
나는 "컴파일 오류 : 예상 배열"을 얻고 문자열) = 단어 (0) JBeans99 @ – BradP
은 (희미한 단어이어야한다 rng.Value에서 – niton
HA! 그래, 결국 나는 그 코드를 너무 오랫동안 쳐다 보았다고 생각했다. 부분적으로 작동이 ... 부분적으로 발생했습니다. 엑셀에 데이터를 추가하는 매크로가 필요합니다. 현재는 데이터를 덮어 쓰고 있습니다. 추가하려면 어떻게해야합니까? 실례가 내 VBA 무지 ...이 처음으로, 나는 약간의 C# 및 ASP.NET 지식이 있습니다. 내 반 가공 코드는 여기에 있습니다 - http://pastebin.com/mXRvVJdN – BradP