VBA宏解析Outlook文件

     Dim myOlApp As Outlook.Application

     Dim myNameSpace As NameSpace

     Dim myibox As MAPIFolder

     Dim mydelitems As MAPIFolder

     Dim myitem As MailItem

     Dim sql_str As String

     Dim strConn As String

     Dim cc As String

     Dim subject As String

     Dim rectime As String

     Dim emailuser As String

     Dim sourceemail As String

     Dim emailbody As String

     Dim length As Integer

     Dim count As Integer

     Dim i As Integer

     Dim email(100) As String

     Dim s As String

     Dim j As Integer

     Dim rs As ADODB.Recordset

     Dim cn As ADODB.Connection

     'strConn = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" + "F:\\\项目\\\\2014\\\\BOSCH_个人信息定制系统\\\\03-软件\\\\Outlook\\\\WindowsFormsApplication3\\\\bin\\\\Debug\\\\info.mdb"

     strConn = "Provider = MSDAORA.1;Password=BOSCH213;User ID=system;Data Source=DASHBOSCH;Persist Security Info=True"

     Set cn = New ADODB.Connection

     cn.Open strConn

     Set rs = New ADODB.Recordset

     rs.ActiveConnection = cn

     Set myOlApp = CreateObject("Outlook.Application")

     Set myNameSpace = myOlApp.GetNamespace("MAPI")

     Set myibox = myNameSpace.GetDefaultFolder(olFolderInbox)

    If msg = vbYes Then ActiveWorkbook.Save Else If msg = vbCancel Then Exit Sub

    length = 0

    For n = 1 To myibox.Items.count

       Set myitem = myibox.Items(n)

       cc = myitem.cc

       subject = myitem.subject

       rectime = myitem.CreationTime

       sourceemail = myitem.SenderEmailAddress

       emailbody = myitem.body

       count = 0

       If subject = "天气" Then

           ReadWeather (emailbody)

       End If

       For i = 0 To 100

           email(i) = ""

       Next i

If cc <> "" Then

          For i = 0 To Len(cc)

               s = Mid(cc, i + 1, 1)

If s <> ";" Then

                  If s = " " Then

                  Else

                      email(count) = email(count) + s

                   End If

               Else

                   count = count + 1

               End If

           Next i

               '邮件信息入库

           For j = 0 To count

              emailuser = email(j)

            sql_str = "insert into EMAILMSG (EMAILADDRESS,SUBJECT,RECTIME,EMAILBODY,SOURCEEMAIL) values('" + emailuser + "','" + subject + "',to_date('" + rectime + "','yyyy/mm/dd hh24:mi:ss'),'" + emailbody + "','" + sourceemail + "')"

              cn.Execute (sql_str)

           Next j

       End If

       length = length + 1

    Next n

    For i = 0 To (length - 1)

       'myibox.Items.Remove (1)

    Next i

    cn.Close

End Sub