2014-10-29 4 views
0

Первый раз я программирования в Outlook, VBA 2007.Outlook.MailItem, объект переменная или переменная блока не установлена ​​

я могу сохранить некоторые данные из электронной почты в файл Excel.

Я думаю, что моя проблема в Outlook.MailItem.

Я бегу этот код:

Option Explicit 

Sub CopyToExcel() 
Dim olItem As Outlook.MailItem 
Dim xlApp As Excel.Application 
Dim xlWB As Object 
Dim xlSheet As Object 
Dim vText, vText2, vText3, vText4, vText5 As Variant 
Dim sText As String 
Dim rCount As Long 
Dim bXStarted As Boolean 
Dim enviro As String 
Dim strPath As String 


enviro = CStr(Environ("USERPROFILE")) 
'the path of the workbook 
strPath = enviro & "\Documents\test1.xlsx" 
    On Error Resume Next 
    Set xlApp = New Excel.Application 
    If Err <> 0 Then 
     Application.StatusBar = "Please wait while Excel source is opened ... " 
     Set xlApp = CreateObject("Excel.Application") 
     bXStarted = True 
    End If 
    On Error GoTo 0 
    'Open the workbook to input the data 
    Set xlWB = xlApp.Workbooks.Open(strPath) 
    Set xlSheet = xlWB.Sheets("Test") 
    ' Process the message record 

    'Find the next empty line of the worksheet 
    rCount = xlSheet.Range("B" & xlSheet.Rows.Count).End(-4162).Row 
    rCount = rCount + 1 

    sText = olItem.Body '<------ error 


    Dim Reg1 As RegExp 
    Dim M1 As MatchCollection 
    Dim M As Match 

    Set Reg1 = New RegExp 

    ' \s* = invisible spaces 
    ' \d* = match digits 
    ' \w* = match alphanumeric 

    With Reg1 
     .Pattern = "((Boa tarde \w*))" 
    End With 
    If Reg1.Test(sText) Then 

     Set M1 = Reg1.Execute(sText) 
     For Each M In M1 
      vText = Trim(M.SubMatches(1)) 
      vText2 = Trim(M.SubMatches(2)) 
      vText3 = Trim(M.SubMatches(3)) 
      vText4 = Trim(M.SubMatches(4)) 
      vText5 = Trim(M.SubMatches(5)) 
     Next 
    End If 

    xlSheet.Range("B" & rCount) = vText 
    xlSheet.Range("c" & rCount) = vText2 
    xlSheet.Range("d" & rCount) = vText3 
    xlSheet.Range("e" & rCount) = vText4 
    xlSheet.Range("f" & rCount) = vText5 

    xlWB.Close 1 
    If bXStarted Then 
     xlApp.Quit 
    End If 
    Set xlApp = Nothing 
    Set xlWB = Nothing 
    Set xlSheet = Nothing 
End Sub 

Но, у меня есть эта ошибка: строку:

sText = olItem.Body 

enter image description here

помощь?

ответ

1

Вы не указали ссылку olItem в любом месте вашего кода, вы только объявили ее на линии Dim olItem As Outlook.MailItem. Вы чего-то упускаете?

+0

Да, извините за ваше время, я пропустил эту строку кода 'Set olItem = Application.ActiveExplorer(). Выбор (1)' – jsantos1991

+1

хорошо, это должно исправить вашу проблему. –