none
outlook 2000 code dosen't work on outlook 2010 RRS feed

  • Question

  • This code works with outlook 2000 basically takes the attachments from email and updates the database but it dosent work with outlook 2010 any Help please

    Public Sub DetachFile(objOutlookMsg As Outlook.MailItem, strTable As String, strExt As String)

        Dim oAttach As Outlook.Attachment

        Dim blnFound As Boolean

        For Each oAttach In objOutlookMsg.Attachments()

            If oAttach.name = strTable & "." & strExt Or oAttach.name = strTable Then

                blnFound = True

                Exit For

            End If

        Next

        On Error Resume Next

       

        If strRAPLoc = "" Then SetRapLoc

       

        Kill strRAPLoc & "impexp\" & strTable & "." & strExt

        On Error GoTo 0

               

        If blnFound Then

            oAttach.WriteToFile (strRAPLoc & "impexp\" & strTable & "." & strExt)

            Set oAttach = Nothing

        Else

            If strTable = "Payroll" Then

                DetachFile objOutlookMsg, "Payroll2", strExt

            Else

                Err.Raise "100", , "Attachment " & strTable & " not found"

            End If

        End If

    End Sub

    Public Function ProcessUpdateEmail() As String

        On Error GoTo ErrFound

        Dim oSess As New MAPI.Session

        Dim oFold As MAPI.Folder

        Dim objOutlookMsg As Outlook.MailItem

        Dim objOutlookMsges As Outlook.MailItems

        Dim oRecip As MAPI.Recipient

        Dim strOut As String

        Dim strResult As String

        Dim strExt As String

       

        oSess.Logon showDialog:=True

           

        Set oFold = oSess.Inbox

        Set objOutlookMsges = oFold.Messages

        strResult = "No Email Found..."

       

        strExt = gstrFileExt

       

        For Each objOutlookMsg In objOutlookMsges

            If Left(objOutlookMsg.Text, 11) = "Update Data" Then

                DetachFile objOutlookMsg, "state", strExt

                DetachFile objOutlookMsg, "county", strExt

                DetachFile objOutlookMsg, "district", strExt

                DetachFile objOutlookMsg, "calculationcode", strExt

                DetachFile objOutlookMsg, "city", strExt

                DetachFile objOutlookMsg, "unit", strExt

                DetachFile objOutlookMsg, "gltypecode", strExt

                DetachFile objOutlookMsg, "registertype", strExt

                DetachFile objOutlookMsg, "expensetype", strExt

                DetachFile objOutlookMsg, "vendor", strExt

                DetachFile objOutlookMsg, "unitvendor", strExt

                DetachFile objOutlookMsg, "unittype", strExt

                DetachFile objOutlookMsg, "employee", strExt

                DetachFile objOutlookMsg, "glaccount", strExt

                DetachFile objOutlookMsg, "glsubaccount", strExt

                DetachFile objOutlookMsg, "empunit", strExt

                DetachFile objOutlookMsg, "unitglaccount", strExt

                DetachFile objOutlookMsg, "inventorycategory", strExt

                DetachFile objOutlookMsg, "register", strExt

               

                strResult = ImportUpdateData

                If strResult <> "" Then

                    strResult = "Error Importing. " & vbCrLf & strResult

                    GoTo ErrFound

                End If

                strResult = "Update Applied."

                objOutlookMsg.Delete

                Set objOutlookMsg = Nothing

            End If

        Next objOutlookMsg

       

        MsgBox strResult

          

        oSess.Logoff

        Set oSess = Nothing

        Exit Function

    ErrFound:

        strOut = strOut & Err.description & vbCrLf

        MsgBox "Error." & vbCrLf & strResult, vbCritical, "Error Processing Updates"

    End Function

    Wednesday, April 25, 2012 10:06 PM

All replies