Outlook (2010) 폴더의 모든 전자 메일을 반복하고 전자 메일 본문에서 전자 메일 주소를 가져 오는 기능이 필요하다는 요구 사항이 있습니다. 이메일은Inbox \ Online Applicants \ TEST CB FOLDER
본문에는 하나의 이메일 주소 만 있습니다. 이 전자 메일 email_output.xls
은 바탕 화면에 있는 Excel 파일로 작성해야합니다 .
에서 이 포럼 스레드 나는 발견하고 약간 나는 (단지 VBA의 피상적 지식을 가지고) 할 수 최고로 내 요구에 맞게 최종 매크로를 변경 한 :
Option Explicit
Sub badAddress()
Dim olApp As Outlook.Application
Dim olNS As Outlook.NameSpace
Dim olFolder As Outlook.MAPIFolder
Dim Item As Object
Dim regEx As Object
Dim olMatches As Object
Dim strBody As String
Dim bcount As String
Dim badAddresses As Variant
Dim i As Long
Dim xlApp As Object 'Excel.Application
Dim xlwkbk As Object 'Excel.Workbook
Dim xlwksht As Object 'Excel.Worksheet
Dim xlRng As Object 'Excel.Range
Set olApp = Outlook.Application
Set olNS = olApp.GetNamespace("MAPI")
Set olFolder = olNS.GetDefaultFolder(olFolderInbox).Folders("Online Applicants").Folders("TEST CB FOLDER")
Set regEx = CreateObject("VBScript.RegExp")
'define regular expression
regEx.Pattern = "\b[A-Z0-9._%-]+@[A-Z0-9.-]+\.[A-Z]{2,4}\b"
regEx.IgnoreCase = True
regEx.Multiline = True
' set up size of variant
bcount = olFolder.Items.Count
ReDim badAddresses(1 To bcount) As String
' initialize variant position counter
i = 0
' parse each message in the folder holding the bounced emails
For Each Item In olFolder.Items
i = i + 1
strBody = olFolder.Items(i).Body
Set olMatches = regEx.Execute(strBody)
If olMatches.Count >= 1 Then
badAddresses(i) = olMatches(0)
Item.UnRead = False
End If
Next Item
' write everything to Excel
Set xlApp = GetExcelApp
If xlApp Is Nothing Then GoTo ExitProc
If Not IsFileOpen(Environ("USERPROFILE") & "\Desktop\email_output.xls") Then
Set xlwkbk = xlApp.workbooks.Open(Environ("USERPROFILE") & "\Desktop\email_output.xls")
End If
Set xlwksht = xlwkbk.Sheets(1)
Set xlRng = xlwksht.Range("A1")
xlApp.ScreenUpdating = False
xlRng.Value = "Bounced email addresses"
' resize version
xlRng.Offset(1, 0).Resize(UBound(badAddresses) + 1).Value = xlApp.Transpose(badAddresses)
xlApp.Visible = True
xlApp.ScreenUpdating = True
ExitProc:
Set xlRng = Nothing
Set xlwksht = Nothing
Set xlwkbk = Nothing
Set xlApp = Nothing
Set olFolder = Nothing
Set olNS = Nothing
Set olApp = Nothing
Set badAddresses = Nothing
End Sub
Function GetExcelApp() As Object
' always create new instance
On Error Resume Next
Set GetExcelApp = CreateObject("Excel.Application")
On Error GoTo 0
End Function
Function IsFileOpen(FileName As String)
Dim iFilenum As Long
Dim iErr As Long
On Error Resume Next
iFilenum = FreeFile()
Open FileName For Input Lock Read As #iFilenum
Close iFilenum
iErr = Err
On Error GoTo 0
Select Case iErr
Case 0: IsFileOpen = False
Case 70: IsFileOpen = True
Case Else: Error iErr
End Select
End Function
내가 관리 할 수있는 몇 가지 다른 오류를 처리 한 후 (46 행) 오류 object variable or with block variable not set
가 발생합니다 Set xlwksht = xlwkbk.Sheets(1)
. 변수가 올바르게 할당 된 것으로 보이며 스프레드 시트는 데스크탑에 올바르게 이름이 지정되어 있습니다.
답변
xlwkbk
설정이 보장되지는 않습니다 : File is Not (Not Open) 인 경우에만 개체를 설정합니다. “else 절”이 필요합니다.
FileIsOpen()
테스트 를 무시하는 대신 결과를 직접 사용하십시오. 같은 :
If FileIsOpen() then
'Do stuff for when file is open, such as test for the proper worksheet being active
set worksheet to active sheet
else
'Open the worksheet like you have in example
set worksheet by opening worksheet
endif