Private Sub Application_NewMail()Dim myOlApp As ApplicationDim myNameSpace As NameSpaceDim myibox As MAPIFolderDim mydelitems As MAPIFolderDim myitem As MailItemDim subject As StringDim rectime As StringDim from_addr As StringDim to_addr As StringDim emailbody As StringDim att_count As IntegerDim sql_str As StringDim strConn As StringDim myGuid As StringDim TypeLibDim i As IntegerDim path As StringDim cn As ObjectSet cn = CreateObject("ADODB.Connection")strConn = "Provider=sqloledb;Server=192.168.3.9;Database=GEARMAGE;Uid=GEARMAGE;Pwd=GEARMAGE;"cn.Open strConnSet myOlApp = CreateObject("Outlook.Application")Set myNameSpace = myOlApp.GetNamespace("MAPI")Set myibox = myNameSpace.GetDefaultFolder(olFolderInbox)Set myFolder = myibox.Folders("PendingProcess")Set mymovefolder = myibox.Folders("Processed")Set TypeLib = CreateObject("Scriptlet.TypeLib")sql_str = String(3000, 0)For n = 1 To myFolder.Items.countSet myitem = myFolder.Items(n)If myitem.UnRead = True Thensubject = myitem.subjectrectime = myitem.CreationTimefrom_addr = myitem.SenderNameto_addr = myitem.Toemailbody = myitem.Bodyatt_count = myitem.Attachments.countmyGuid = Mid(TypeLib.GUID, 2, 36)sql_str = "INSERT INTO dbo.OUTLOOK_VBA_TEST( ID ,NAME ,EMAIL_DATE ,FROM_ADDR ,TO_ADDRS ,EMAIL_BODY ,ATTACHMENTS_COUNT) VALUES  ('" + myGuid + "','" + subject + "','" + rectime + "','" + from_addr + "','" + to_addr + "','" + emailbody + "'," + CStr(att_count) + ")"cn.Execute (sql_str)If att_count > 0 ThenFor i = 1 To att_countSet olAtt = myitem.Attachments(i)path = "D:\Email Attachment Temp\{" + myGuid + "}" + olAtt.FileNameolAtt.SaveAsFile pathNextEnd IfEnd Ifmyitem.Move mymovefolderNext ncn.CloseSet cn = NothingSet fldFolder = NothingSet myNameSpace = NothingEnd Sub