搜索和出口数据从展望到EXCEL（2010年办公室） [英] SEARCH AND EXPORT DATA FROM OUTLOOK TO EXCEL (OFFICE 2010)

问题描述

您好，

您能否帮助我使用VBA宏，以便将来自  outlook 消息的特定数据导出到Excel？

我收到此电子邮件结构：

<强> Y'NBSP; - >这是一个数字（1-9） 它是电子邮件正文中的第一个字符。

< span style ="font-family：'Tahoma'，'sans-serif'; font-size：10pt">

La entrada
INC00000XXXXXXX  - > XXXXXXX可以是任何数目的 <强>&NBSP; referente一个FALLO SISTEMA EURIAN公顷sido solucionada。

< span style ="font-family：'Verdana'，'sans-serif'; font-size：10pt">

我需要excel这2（ Y 和
INC00000XXXXXXX） 以下格式的值

INC00000XXXXXXX

Y

谢谢，

解决方案

创建在"在A1与两个列标题的工作簿和B1;工作表Sheet"并保存它作为xlsx格式。列标题的名称无关紧要，但表格上只能有两列。

将以下内容复制到新的Outlook VBA模块

创建Outlook规则以识别包含相关数据的传入邮件，并从该规则运行以下脚本
CopytoExce l。

我已经包含了一个测试宏，以便您可以使用选定的消息对其进行测试。如果消息格式与您所描述的一样，则应将数据添加到工作表中。

选项显式

Sub CopytoExcel（olItem As Outlook.MailItem）

Dim sBody As String

Dim strText As String

Dim vText As Variant

Dim vItem As Variant

Dim strNum As String

Dim strVal As String

Dim i As Long

Dim strValues As String

Const strWorkbook As String =" D：\ Path \\ \\MessageLog.xlsx " '工作簿的路径

Const strSheet As String =" Sheet1" '表格的名称

    sBody = olItem.Body

    vText = Split（sBody，Chr（13））

   如果是IsNumeric（左（vText（0），1））则为

        strNum = Left（vText（0），1）

   结束如果是
   对于i = 0到UBound（vText）

       如果InStr（1，vText（i），"La entrada"）> 0然后

            strText = vText（i）

            vItem = Split（strText，Chr（32））

            strVal = Trim（vItem（2））

           退出为
       结束如果是
   接下来我是
    strValues = strVal& "'，'" &安培; strNum

    WriteToWorksheet strWorkbook，"Sheet1"，strValues

End Sub





公共函数WriteToWorksheet（strWorkbook As String ，_

&NBSP;&NBSP;&NBSP;&NBSP;&NBSP;&NBSP;&NBSP;&NBSP;&NBSP;&NBSP;&NBSP;&NBSP;&NBSP;&NBSP;&NBSP;&NBSP;&NBSP;&NBSP;&NBSP;&NBSP; &NBSP;&NBSP;&NBSP;&NBSP;&NBSP;&NBSP;&NBSP;&NBSP;&NBSP;&NBSP;&NBSP;&NBSP; strRange作为字符串_

&NBSP;&NBSP;&NBSP;&NBSP;&NBSP;&NBSP;&NBSP ;&NBSP;&NBSP;&NBSP;&NBSP;&NBSP;&NBSP;&NBSP;&NBSP;&NBSP;&NBSP;&NBSP;&NBSP;&NBSP;&NBSP;&NBSP;&NBSP;&NBSP;&NBSP;&NBSP;&NBSP;&NBSP;&NBSP;&NBSP;&NBSP;&NBSP ; strValues As String）

Dim ConnectionString As String

Dim strSQL As String

Dim CN As Object

  ;&NBSP;&NBSP; ConnectionString =" Provider = Microsoft.ACE.OLEDB.12.0;" &安培; _

&NBSP;&NBSP;&NBSP;&NBSP;&NBSP;&NBSP;&NBSP;&NBSP;&NBSP;&NBSP;&NBSP;&NBSP;&NBSP;&NBSP;&NBSP;&NBSP;&NBSP;&NBSP;&NBSP;&NBSP;&NBSP ;&NBSP; "数据源=" &安培; strWorkbook&英寸;" &安培; _

&NBSP;&NBSP;&NBSP;&NBSP;&NBSP;&NBSP;&NBSP;&NBSP;&NBSP;&NBSP;&NBSP;&NBSP;&NBSP;&NBSP;&NBSP;&NBSP;&NBSP;&NBSP;&NBSP;&NBSP;&NBSP ;&NBSP; "扩展属性="" Excel 12.0 Xml; HDR = YES;"" ;;"

    strSQL =" INSERT INTO [" &安培; strRange& "

VALUES（'"& strValues&"'）" b
   设置CN = CreateObject（" ADODB.Connection"）

   呼叫CN.Open（ConnectionString）

   拨打CN.Execute（strSQL ,, 1或128）

    CN.Close

   设置CN = Nothing

结束功能



子测试（）'选择一条消息并运行此宏来测试代码。

Dim olMsg作为MailItem

    On Error Resume Next

   设置olMsg = ActiveExplorer.Selection.Item（1）

    CopytoExcel olMsg

End Sub

Hi,

Can you help me with a VBA macro that allow me to export especific data from outlook messages to excel?

I recieve this email message estructure:

Y --> This is a single digit (1-9) and it is the first character in the email body.

La entrada INC00000XXXXXXX --> XXXXXXX Could be any number referente a FALLO SISTEMA EURIAN ha sido solucionada.

And I need in excel this 2 (Y and INC00000XXXXXXX ) values in the following format

INC00000XXXXXXX

Y

Thanks,

解决方案

Create a workbook with two column headings at A1 and B1 in "Sheet1" and save it as xlsx format. The names of the column headings is irrelevant but there must only be two columns on the sheet.

Copy the following to a new Outlook VBA Module

Create an Outlook rule to identify the incoming messages with the data in question and run the following script CopytoExcel from that rule.

I have included a test macro so that you can test it with a selected message. If the message format is as you described then it should add the data to the worksheet.

Option Explicit
Sub CopytoExcel(olItem As Outlook.MailItem)
Dim sBody As String
Dim strText As String
Dim vText As Variant
Dim vItem As Variant
Dim strNum As String
Dim strVal As String
Dim i As Long
Dim strValues As String
Const strWorkbook As String = "D:\Path\MessageLog.xlsx" 'The path of the workbook
Const strSheet As String = "Sheet1" 'The name of the sheet
    sBody = olItem.Body
    vText = Split(sBody, Chr(13))
    If IsNumeric(Left(vText(0), 1)) Then
        strNum = Left(vText(0), 1)
    End If
    For i = 0 To UBound(vText)
        If InStr(1, vText(i), "La entrada") > 0 Then
            strText = vText(i)
            vItem = Split(strText, Chr(32))
            strVal = Trim(vItem(2))
            Exit For
        End If
    Next i
    strValues = strVal & "', '" & strNum
    WriteToWorksheet strWorkbook, "Sheet1", strValues
End Sub


Public Function WriteToWorksheet(strWorkbook As String, _
                                 strRange As String, _
                                 strValues As String)
Dim ConnectionString As String
Dim strSQL As String
Dim CN As Object
    ConnectionString = "Provider=Microsoft.ACE.OLEDB.12.0;" & _
                       "Data Source=" & strWorkbook & ";" & _
                       "Extended Properties=""Excel 12.0 Xml;HDR=YES;"";"
    strSQL = "INSERT INTO [" & strRange & "

VALUES('" & strValues & "')"
    Set CN = CreateObject("ADODB.Connection")
    Call CN.Open(ConnectionString)
    Call CN.Execute(strSQL, , 1 Or 128)
    CN.Close
    Set CN = Nothing
End Function

Sub Test() 'Select a message and run this macro to test the code.
Dim olMsg As MailItem
    On Error Resume Next
    Set olMsg = ActiveExplorer.Selection.Item(1)
    CopytoExcel olMsg
End Sub

这篇关于搜索和出口数据从展望到EXCEL（2010年办公室）的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持IT屋！