반응형
VBA 또는 매크로를 사용하여 Outlook 메일 메시지를 Excel로 복사하는 방법
저는 VBA와 매크로 초보자입니다.누군가 VBA 코드와 매크로를 도와주면 도움이 될 것 같습니다.
매일 약 50-60통의 메일을 받는데, 한 가지 표준 제목은 "작업 완료"입니다.이러한 모든 메일에 대해 "작업 완료"라는 특정 폴더로 이동하는 규칙을 만들었습니다.
하루에 50-60개의 메일을 모두 읽고 모든 메일을 업데이트하는 것은 매우 많은 시간이 걸립니다.내 받은 편지함으로 오는 50-60개의 모든 메일은 다른 사용자로부터 오는 동일한 제목을 가집니다.우편물 본문은 다양합니다.
저는 Outlook 2010과 Excel 2010을 사용하고 있습니다.
당신이 복사해야 할 것에 대해 언급하지 않았기 때문에, 아래 코드에서 해당 섹션을 비워두었습니다.
또한 전자 메일을 먼저 폴더로 이동한 다음 해당 폴더에서 매크로를 실행할 필요가 없습니다.수신 메일에서 매크로를 실행한 후 동시에 폴더로 이동할 수 있습니다.
그러면 시작할 수 있습니다.코드를 이해하는 데 문제가 없도록 코드를 주석으로 달았습니다.
먼저 아래에 언급된 코드를 아웃룩 모듈에 붙여넣습니다.
그리고나서
- 도구 클릭~~>규칙 및 알림
- "새 규칙" 클릭
- 빈 규칙에서 시작을 클릭합니다.
- 메시지 도착 시 확인을 선택합니다.
- 조건에서 "제목에 특정 단어 포함"을 클릭합니다.
- 규칙 설명에서 "특정 단어"를 클릭합니다.
- 팝업 대화 상자에 확인할 단어를 입력하고 "추가"를 클릭합니다.
- 확인을 클릭하고 다음을 클릭합니다.
- 지정된 폴더로 이동을 선택하고 동일한 상자에서 "스크립트 실행"도 선택합니다.
- 아래 상자에서 특정 폴더와 실행할 스크립트(모듈에 있는 매크로)를 지정합니다.
- 완료를 클릭하면 완료됩니다.
새 전자 메일이 도착하면 지정한 폴더로 전자 메일이 이동할 뿐만 아니라 해당 전자 메일의 데이터도 Excel로 내보냅니다.
코드
Const xlUp As Long = -4162
Sub ExportToExcel(MyMail As MailItem)
Dim strID As String, olNS As Outlook.Namespace
Dim olMail As Outlook.MailItem
Dim strFileName As String
'~~> Excel Variables
Dim oXLApp As Object, oXLwb As Object, oXLws As Object
Dim lRow As Long
strID = MyMail.EntryID
Set olNS = Application.GetNamespace("MAPI")
Set olMail = olNS.GetItemFromID(strID)
'~~> Establish an EXCEL application object
On Error Resume Next
Set oXLApp = GetObject(, "Excel.Application")
'~~> If not found then create new instance
If Err.Number <> 0 Then
Set oXLApp = CreateObject("Excel.Application")
End If
Err.Clear
On Error GoTo 0
'~~> Show Excel
oXLApp.Visible = True
'~~> Open the relevant file
Set oXLwb = oXLApp.Workbooks.Open("C:\Sample.xls")
'~~> Set the relevant output sheet. Change as applicable
Set oXLws = oXLwb.Sheets("Sheet1")
lRow = oXLws.Range("A" & oXLApp.Rows.Count).End(xlUp).Row + 1
'~~> Write to outlook
With oXLws
'
'~~> Code here to output data from email to Excel File
'~~> For example
'
.Range("A" & lRow).Value = olMail.Subject
.Range("B" & lRow).Value = olMail.SenderName
'
End With
'~~> Close and Clean up Excel
oXLwb.Close (True)
oXLApp.Quit
Set oXLws = Nothing
Set oXLwb = Nothing
Set oXLApp = Nothing
Set olMail = Nothing
Set olNS = Nothing
End Sub
따르다
전자 메일 본문에서 내용을 추출하려면 SPLIT()를 사용하여 내용을 분할한 다음 관련 정보를 구문 분석할 수 있습니다.이 예 참조
Dim MyAr() As String
MyAr = Split(olMail.body, vbCrLf)
For i = LBound(MyAr) To UBound(MyAr)
'~~> This will give you the contents of your email
'~~> on separate lines
Debug.Print MyAr(i)
Next i
새로운 소개 2
이전 버전의 매크로 "SaveEmailDetails"에서 받은 편지함을 찾기 위해 다음 문장을 사용했습니다.
Set FolderTgt = CreateObject("Outlook.Application"). _
GetNamespace("MAPI").GetDefaultFolder(olFolderInbox)
그 이후로 새로운 버전의 Outlook을 설치했는데 기본 받은 편지함을 사용하지 않습니다.각 전자 메일 계정에 대해 받은 편지함이 있는 별도의 저장소(전자 메일 주소 이름)를 만들었습니다.받은 편지함은 기본값이 아닙니다.
이 매크로는 기본 받은 편지함을 가지고 있는 저장소의 이름을 즉시 창으로 출력합니다.
Sub DsplUsernameOfDefaultStore()
Dim NS As Outlook.NameSpace
Dim DefaultInboxFldr As MAPIFolder
Set NS = CreateObject("Outlook.Application").GetNamespace("MAPI")
Set DefaultInboxFldr = NS.GetDefaultFolder(olFolderInbox)
Debug.Print DefaultInboxFldr.Parent.Name
End Sub
설치 시 "Outlook Data File"이 출력됩니다.
매크로 "Save Email Details"에 모든 상점의 받은 편지함에 액세스하는 방법을 보여주는 추가 문을 추가했습니다.
새로운 소개 1
많은 사람들이 아래 매크로를 선택하여 유용하다고 생각하고 추가적인 조언을 위해 저에게 직접 연락했습니다.이러한 연락에 따라 매크로를 몇 가지 개선하여 아래에 수정 버전을 게시했습니다.또한 Outlook 계층이 있는 폴더에 대한 MAPI 폴더 개체를 함께 반환하는 매크로를 추가했습니다.기본 폴더가 아닌 다른 폴더에 액세스하려는 경우 유용합니다.
원본 텍스트는 이전 질문과 연결된 날짜별로 하나의 질문을 참조했습니다.첫 번째 질문이 삭제되어 링크가 손실되었습니다.해당 링크는 Outlook 메일을 기반으로 Excel 시트 업데이트(닫힘)에 대한 링크였습니다.
원문
"Outlook 이메일에서 Excel 워크북으로 데이터를 추출하려면 어떻게 해야 합니까?"라는 질문에는 놀라울 정도로 다양한 종류가 있습니다.예를 들어, [outlook-vba]에 대한 두 개의 질문이 8월 13일에 동일한 질문에 대해 제기되었습니다.그 질문은 제가 답변을 시도했던 12월의 변화를 언급합니다.
12월 질문에 대해, 저는 두 부분으로 대답하는 것을 지나쳤습니다.첫 번째 부분은 Outlook 폴더 구조를 탐색하고 텍스트 파일이나 Excel 워크북에 데이터를 쓰는 일련의 교수 매크로였습니다.두 번째 파트에서는 추출 공정을 설계하는 방법에 대해 논의했습니다.이 질문에 대해 Siddarth는 훌륭하고 간결한 답변과 다음 단계에 도움이 되는 후속 조치를 제공했습니다.
모든 변형에 대한 질문자가 이해할 수 없는 것처럼 보이는 것은 화면에서 데이터가 어떻게 보이는지 보여준다고 해서 텍스트나 HTML 본문이 어떻게 생겼는지 알려주지 않는다는 것입니다.이 대답은 그 문제를 극복하기 위한 시도입니다.
아래 매크로는 Siddarth의 매크로보다 더 복잡하지만 제가 12월 답변에 포함한 매크로보다 훨씬 간단합니다.추가할 수 있는 것이 더 있지만 이 정도면 충분하다고 생각합니다.
매크로는 새 Excel 워크북을 만들고 받은 문서에 있는 모든 전자 메일의 선택된 속성을 출력하여 이 워크시트를 만듭니다.
매크로의 맨 위 근처에는 8개의 해시(#)가 포함된 주석이 있습니다.아래 설명문은 Excel 워크북이 작성될 폴더를 식별하기 때문에 변경해야 합니다.
해시가 포함된 다른 모든 설명은 매크로를 사용자의 요구 사항에 맞게 조정하기 위한 수정 사항을 제안합니다.
데이터를 추출할 이메일은 어떻게 식별됩니까?보낸 사람, 대상, 몸 안에 있는 문자열입니까, 아니면 이 모든 것입니까?설명은 흥미 없는 전자 메일을 제거하는 데 도움이 됩니다.만약 내가 질문을 올바르게 이해한다면, 흥미로운 이메일은Subject = "Task Completed".
주석은 관심 있는 전자 메일에서 데이터를 추출하는 데 도움이 되지 않지만 워크시트에는 전자 메일 본문의 텍스트 버전과 HTML 버전이 모두 표시됩니다.제 생각은 여러분이 매크로가 무엇을 볼 것인지 보고 추출 과정을 설계하기 시작할 수 있다는 것입니다.
위의 화면 이미지에는 표시되지 않지만 매크로는 텍스트 본문에 두 가지 버전을 출력합니다.첫 번째 버전은 변경되지 않았습니다. 즉, 탭, 캐리지 리턴, 라인 피드가 준수되고 공백이 아닌 모든 공간이 공백처럼 보입니다.두 번째 버전에서는 이러한 코드를 [TB], [CR], [LF] 및 [NBSP] 문자열로 바꾸어 표시했습니다.제가 이해한 내용이 맞다면, 두 번째 텍스트 본문에서 다음을 볼 수 있을 것입니다.
활동[TAB]수[CR][LF]열림[TAB]35[CR][LF]HCQA[TAB]42[CR][LF]HCQC[TAB]60[CR][LF]HABST[TAB]50 45 5 2 21 [CR][LF] 등
이 문자열의 원본에서 값을 추출하는 것은 어렵지 않습니다.
저는 이메일의 속성과 함께 추출된 값을 출력하도록 매크로를 수정하려고 합니다.이 변경을 성공적으로 완료해야 추출된 데이터를 기존 워크북에 쓰려고 합니다.또한 처리된 이메일을 다른 폴더로 이동할 것입니다.저는 이러한 변화가 이루어져야 하는 곳을 보여줬지만 더 이상의 도움은 주지 않았습니다.당신이 이 정보가 필요한 시점에 도달하면 보충 질문에 답변하겠습니다.
행운을 빌어요.
원본 텍스트에 포함된 매크로의 최신 버전
Option Explicit
Public Sub SaveEmailDetails()
' This macro creates a new Excel workbook and writes to it details
' of every email in the Inbox.
' Lines starting with hashes either MUST be changed before running the
' macro or suggest changes you might consider appropriate.
Dim AttachCount As Long
Dim AttachDtl() As String
Dim ExcelWkBk As Excel.Workbook
Dim FileName As String
Dim FolderTgt As MAPIFolder
Dim HtmlBody As String
Dim InterestingItem As Boolean
Dim InxAttach As Long
Dim InxItemCrnt As Long
Dim PathName As String
Dim ReceivedTime As Date
Dim RowCrnt As Long
Dim SenderEmailAddress As String
Dim SenderName As String
Dim Subject As String
Dim TextBody As String
Dim xlApp As Excel.Application
' The Excel workbook will be created in this folder.
' ######## Replace "C:\DataArea\SO" with the name of a folder on your disc.
PathName = "C:\DataArea\SO"
' This creates a unique filename.
' #### If you use a version of Excel 2003, change the extension to "xls".
FileName = Format(Now(), "yymmdd hhmmss") & ".xlsx"
' Open own copy of Excel
Set xlApp = Application.CreateObject("Excel.Application")
With xlApp
' .Visible = True ' This slows your macro but helps during debugging
.ScreenUpdating = False ' Reduces flash and increases speed
' Create a new workbook
' #### If updating an existing workbook, replace with an
' #### Open workbook statement.
Set ExcelWkBk = xlApp.Workbooks.Add
With ExcelWkBk
' #### None of this code will be useful if you are adding
' #### to an existing workbook. However, it demonstrates a
' #### variety of useful statements.
.Worksheets("Sheet1").Name = "Inbox" ' Rename first worksheet
With .Worksheets("Inbox")
' Create header line
With .Cells(1, "A")
.Value = "Field"
.Font.Bold = True
End With
With .Cells(1, "B")
.Value = "Value"
.Font.Bold = True
End With
.Columns("A").ColumnWidth = 18
.Columns("B").ColumnWidth = 150
End With
End With
RowCrnt = 2
End With
' FolderTgt is the folder I am going to search. This statement says
' I want to seach the Inbox. The value "olFolderInbox" can be replaced
' to allow any of the standard folders to be searched.
' See FindSelectedFolder() for a routine that will search for any folder.
Set FolderTgt = CreateObject("Outlook.Application"). _
GetNamespace("MAPI").GetDefaultFolder(olFolderInbox)
' #### Use the following the access a non-default Inbox.
' #### Change "Xxxx" to name of one of your store you want to access.
Set FolderTgt = Session.Folders("Xxxx").Folders("Inbox")
' This examines the emails in reverse order. I will explain why later.
For InxItemCrnt = FolderTgt.Items.Count To 1 Step -1
With FolderTgt.Items.Item(InxItemCrnt)
' A folder can contain several types of item: mail items, meeting items,
' contacts, etc. I am only interested in mail items.
If .Class = olMail Then
' Save selected properties to variables
ReceivedTime = .ReceivedTime
Subject = .Subject
SenderName = .SenderName
SenderEmailAddress = .SenderEmailAddress
TextBody = .Body
HtmlBody = .HtmlBody
AttachCount = .Attachments.Count
If AttachCount > 0 Then
ReDim AttachDtl(1 To 7, 1 To AttachCount)
For InxAttach = 1 To AttachCount
' There are four types of attachment:
' * olByValue 1
' * olByReference 4
' * olEmbeddedItem 5
' * olOLE 6
Select Case .Attachments(InxAttach).Type
Case olByValue
AttachDtl(1, InxAttach) = "Val"
Case olEmbeddeditem
AttachDtl(1, InxAttach) = "Ebd"
Case olByReference
AttachDtl(1, InxAttach) = "Ref"
Case olOLE
AttachDtl(1, InxAttach) = "OLE"
Case Else
AttachDtl(1, InxAttach) = "Unk"
End Select
' Not all types have all properties. This code handles
' those missing properties of which I am aware. However,
' I have never found an attachment of type Reference or OLE.
' Additional code may be required for them.
Select Case .Attachments(InxAttach).Type
Case olEmbeddeditem
AttachDtl(2, InxAttach) = ""
Case Else
AttachDtl(2, InxAttach) = .Attachments(InxAttach).PathName
End Select
AttachDtl(3, InxAttach) = .Attachments(InxAttach).FileName
AttachDtl(4, InxAttach) = .Attachments(InxAttach).DisplayName
AttachDtl(5, InxAttach) = "--"
' I suspect Attachment had a parent property in early versions
' of Outlook. It is missing from Outlook 2016.
On Error Resume Next
AttachDtl(5, InxAttach) = .Attachments(InxAttach).Parent
On Error GoTo 0
AttachDtl(6, InxAttach) = .Attachments(InxAttach).Position
' Class 5 is attachment. I have never seen an attachment with
' a different class and do not see the purpose of this property.
' The code will stop here if a different class is found.
Debug.Assert .Attachments(InxAttach).Class = 5
AttachDtl(7, InxAttach) = .Attachments(InxAttach).Class
Next
End If
InterestingItem = True
Else
InterestingItem = False
End If
End With
' The most used properties of the email have been loaded to variables but
' there are many more properies. Press F2. Scroll down classes until
' you find MailItem. Look through the members and note the name of
' any properties that look useful. Look them up using VB Help.
' #### You need to add code here to eliminate uninteresting items.
' #### For example:
'If SenderEmailAddress <> "JohnDoe@AcmeSoftware.co.zy" Then
' InterestingItem = False
'End If
'If InStr(Subject, "Accounts payable") = 0 Then
' InterestingItem = False
'End If
'If AttachCount = 0 Then
' InterestingItem = False
'End If
' #### If the item is still thought to be interesting I
' #### suggest extracting the required data to variables here.
' #### You should consider moving processed emails to another
' #### folder. The emails are being processed in reverse order
' #### to allow this removal of an email from the Inbox without
' #### effecting the index numbers of unprocessed emails.
If InterestingItem Then
With ExcelWkBk
With .Worksheets("Inbox")
' #### This code creates a dividing row and then
' #### outputs a property per row. Again it demonstrates
' #### statements that are likely to be useful in the final
' #### version
' Create dividing row between emails
.Rows(RowCrnt).RowHeight = 5
.Range(.Cells(RowCrnt, "A"), .Cells(RowCrnt, "B")) _
.Interior.Color = RGB(0, 255, 0)
RowCrnt = RowCrnt + 1
.Cells(RowCrnt, "A").Value = "Sender name"
.Cells(RowCrnt, "B").Value = SenderName
RowCrnt = RowCrnt + 1
.Cells(RowCrnt, "A").Value = "Sender email address"
.Cells(RowCrnt, "B").Value = SenderEmailAddress
RowCrnt = RowCrnt + 1
.Cells(RowCrnt, "A").Value = "Received time"
With .Cells(RowCrnt, "B")
.NumberFormat = "@"
.Value = Format(ReceivedTime, "mmmm d, yyyy h:mm")
End With
RowCrnt = RowCrnt + 1
.Cells(RowCrnt, "A").Value = "Subject"
.Cells(RowCrnt, "B").Value = Subject
RowCrnt = RowCrnt + 1
If AttachCount > 0 Then
.Cells(RowCrnt, "A").Value = "Attachments"
.Cells(RowCrnt, "B").Value = "Inx|Type|Path name|File name|Display name|Parent|Position|Class"
RowCrnt = RowCrnt + 1
For InxAttach = 1 To AttachCount
.Cells(RowCrnt, "B").Value = InxAttach & "|" & _
AttachDtl(1, InxAttach) & "|" & _
AttachDtl(2, InxAttach) & "|" & _
AttachDtl(3, InxAttach) & "|" & _
AttachDtl(4, InxAttach) & "|" & _
AttachDtl(5, InxAttach) & "|" & _
AttachDtl(6, InxAttach) & "|" & _
AttachDtl(7, InxAttach)
RowCrnt = RowCrnt + 1
Next
End If
If TextBody <> "" Then
' ##### This code was in the original version of the macro
' ##### but I did not find it as useful as the other version of
' ##### the text body. See below
' This outputs the text body with CR, LF and TB obeyed
'With .Cells(RowCrnt, "A")
' .Value = "text body"
' .VerticalAlignment = xlTop
'End With
'With .Cells(RowCrnt, "B")
' ' The maximum size of a cell 32,767
' .Value = Mid(TextBody, 1, 32700)
' .WrapText = True
'End With
'RowCrnt = RowCrnt + 1
' This outputs the text body with NBSP, CR, LF and TB
' replaced by strings.
With .Cells(RowCrnt, "A")
.Value = "text body"
.VerticalAlignment = xlTop
End With
TextBody = Replace(TextBody, Chr(160), "[NBSP]")
TextBody = Replace(TextBody, vbCr, "[CR]")
TextBody = Replace(TextBody, vbLf, "[LF]")
TextBody = Replace(TextBody, vbTab, "[TB]")
With .Cells(RowCrnt, "B")
' The maximum size of a cell 32,767
.Value = Mid(TextBody, 1, 32700)
.WrapText = True
End With
RowCrnt = RowCrnt + 1
End If
If HtmlBody <> "" Then
' ##### This code was in the original version of the macro
' ##### but I did not find it as useful as the other version of
' ##### the html body. See below
' This outputs the html body with CR, LF and TB obeyed
'With .Cells(RowCrnt, "A")
' .Value = "Html body"
' .VerticalAlignment = xlTop
'End With
'With .Cells(RowCrnt, "B")
' .Value = Mid(HtmlBody, 1, 32700)
' .WrapText = True
'End With
'RowCrnt = RowCrnt + 1
' This outputs the html body with NBSP, CR, LF and TB
' replaced by strings.
With .Cells(RowCrnt, "A")
.Value = "Html body"
.VerticalAlignment = xlTop
End With
HtmlBody = Replace(HtmlBody, Chr(160), "[NBSP]")
HtmlBody = Replace(HtmlBody, vbCr, "[CR]")
HtmlBody = Replace(HtmlBody, vbLf, "[LF]")
HtmlBody = Replace(HtmlBody, vbTab, "[TB]")
With .Cells(RowCrnt, "B")
.Value = Mid(HtmlBody, 1, 32700)
.WrapText = True
End With
RowCrnt = RowCrnt + 1
End If
End With
End With
End If
Next
With xlApp
With ExcelWkBk
' Write new workbook to disc
If Right(PathName, 1) <> "\" Then
PathName = PathName & "\"
End If
.SaveAs FileName:=PathName & FileName
.Close
End With
.Quit ' Close our copy of Excel
End With
Set xlApp = Nothing ' Clear reference to Excel
End Sub
매크로는 원래 게시물에 포함되지 않았지만 위 매크로의 일부 사용자가 유용하다고 생각했습니다.
Public Sub FindSelectedFolder(ByRef FolderTgt As MAPIFolder, _
ByVal NameTgt As String, ByVal NameSep As String)
' This routine (and its sub-routine) locate a folder within the hierarchy and
' returns it as an object of type MAPIFolder
' NameTgt The name of the required folder in the format:
' FolderName1 NameSep FolderName2 [ NameSep FolderName3 ] ...
' If NameSep is "|", an example value is "Personal Folders|Inbox"
' FolderName1 must be an outer folder name such as
' "Personal Folders". The outer folder names are typically the names
' of PST files. FolderName2 must be the name of a folder within
' Folder1; in the example "Inbox". FolderName2 is compulsory. This
' routine cannot return a PST file; only a folder within a PST file.
' FolderName3, FolderName4 and so on are optional and allow a folder
' at any depth with the hierarchy to be specified.
' NameSep A character or string used to separate the folder names within
' NameTgt.
' FolderTgt On exit, the required folder. Set to Nothing if not found.
' This routine initialises the search and finds the top level folder.
' FindSelectedSubFolder() is used to find the target folder within the
' top level folder.
Dim InxFolderCrnt As Long
Dim NameChild As String
Dim NameCrnt As String
Dim Pos As Long
Dim TopLvlFolderList As Folders
Set FolderTgt = Nothing ' Target folder not found
Set TopLvlFolderList = _
CreateObject("Outlook.Application").GetNamespace("MAPI").Folders
' Split NameTgt into the name of folder at current level
' and the name of its children
Pos = InStr(NameTgt, NameSep)
If Pos = 0 Then
' I need at least a level 2 name
Exit Sub
End If
NameCrnt = Mid(NameTgt, 1, Pos - 1)
NameChild = Mid(NameTgt, Pos + 1)
' Look for current name. Drop through and return nothing if name not found.
For InxFolderCrnt = 1 To TopLvlFolderList.Count
If NameCrnt = TopLvlFolderList(InxFolderCrnt).Name Then
' Have found current name. Call FindSelectedSubFolder() to
' look for its children
Call FindSelectedSubFolder(TopLvlFolderList.Item(InxFolderCrnt), _
FolderTgt, NameChild, NameSep)
Exit For
End If
Next
End Sub
Public Sub FindSelectedSubFolder(FolderCrnt As MAPIFolder, _
ByRef FolderTgt As MAPIFolder, _
ByVal NameTgt As String, ByVal NameSep As String)
' See FindSelectedFolder() for an introduction to the purpose of this routine.
' This routine finds all folders below the top level
' FolderCrnt The folder to be seached for the target folder.
' NameTgt The NameTgt passed to FindSelectedFolder will be of the form:
' A|B|C|D|E
' A is the name of outer folder which represents a PST file.
' FindSelectedFolder() removes "A|" from NameTgt and calls this
' routine with FolderCrnt set to folder A to search for B.
' When this routine finds B, it calls itself with FolderCrnt set to
' folder B to search for C. Calls are nested to whatever depth are
' necessary.
' NameSep As for FindSelectedSubFolder
' FolderTgt As for FindSelectedSubFolder
Dim InxFolderCrnt As Long
Dim NameChild As String
Dim NameCrnt As String
Dim Pos As Long
' Split NameTgt into the name of folder at current level
' and the name of its children
Pos = InStr(NameTgt, NameSep)
If Pos = 0 Then
NameCrnt = NameTgt
NameChild = ""
Else
NameCrnt = Mid(NameTgt, 1, Pos - 1)
NameChild = Mid(NameTgt, Pos + 1)
End If
' Look for current name. Drop through and return nothing if name not found.
For InxFolderCrnt = 1 To FolderCrnt.Folders.Count
If NameCrnt = FolderCrnt.Folders(InxFolderCrnt).Name Then
' Have found current name.
If NameChild = "" Then
' Have found target folder
Set FolderTgt = FolderCrnt.Folders(InxFolderCrnt)
Else
'Recurse to look for children
Call FindSelectedSubFolder(FolderCrnt.Folders(InxFolderCrnt), _
FolderTgt, NameChild, NameSep)
End If
Exit For
End If
Next
' If NameCrnt not found, FolderTgt will be returned unchanged. Since it is
' initialised to Nothing at the beginning, that will be the returned value.
End Sub
언급URL : https://stackoverflow.com/questions/11876549/how-to-copy-outlook-mail-message-into-excel-using-vba-or-macros
반응형
'programing' 카테고리의 다른 글
| Excel VBA 코드의 XMLHttp 응답에서 JSON 개체 처리 (0) | 2023.06.12 |
|---|---|
| Angular2(TypeScript)의 유닛 테스트/모킹 창 속성 (0) | 2023.06.12 |
| 오류: 버전 충돌 수정(Google-services (0) | 2023.06.12 |
| API 수준 변경 Android Studio (0) | 2023.06.12 |
| HttpClient를 사용하여 이미지 업로드 (0) | 2023.06.12 |