Ciao Ragazzi,
come posso collegarni con il server exchange per leggere la mailbox??
Vorrei leggere tutte le mail presenti in inbox.
Grazie per le vostre info....se ci saranno![]()
![]()
Ciao Ragazzi,
come posso collegarni con il server exchange per leggere la mailbox??
Vorrei leggere tutte le mail presenti in inbox.
Grazie per le vostre info....se ci saranno![]()
![]()
In VB6 non credo, io lo faccio con ADO.NET ....
Comunque con questo codice puoi leggere i dati di Outlook
This code will useful to read outlook mails via VB6,
Make sure your outlook must connect with Microsoft Exchange Server. When run this code at the time outlook also running.
Regards,
Murugan.
bolTemp = True '// Only used to create attachment folder one time only
bolTemp1 = True '// For NewEmailFolder and Email Folder Only
'//Open your Exchange server and logon on it
Set oSession = CreateObject("MAPI.Session")
oSession.Logon , , False, False, 0 'Use the existing Outlook session.
Set oFolder = oSession.Inbox
Set oMessages = oFolder.Messages
Set oMsg = oMessages.GetFirst
Screen.MousePointer = vbHourglass ' the DeliverNow method could take a while right?
oSession.DeliverNow ' this now gets all mail services sent and delivered just as the menu option, tools/deliver now/all services does
'
While Not oMsg Is Nothing ' If the message collection was empty, oMsg should be equal to the Nothing object, not "Is" operator takes object inputs
If oMsg.Unread = True Then
strEmailToAdd = oMsg.Sender.Address
strEmailFromAdd = oMsg.Sender.Address
strEmailBody = Trim(Replace(oMsg.Text, "'", """"))
strEmailSubject = Trim(Replace(oMsg.Subject, "'", "''"))
EmailRecivedDate = oMsg.TimeReceived
EmailSendDate = oMsg.TimeSent
Call OpenDataBaseAndStoreDetailsY(strEmailFromAdd, strEmailToAdd, strEmailSubject, strEmailBody, EmailRecivedDate, EmailSendDate)
'// This will store all attechment files into the spacified path
If oMsg.Attachments.Count > 0 Then
'// Check if the directory name Attachment is alrady exit in application path
DirPath = App.Path & "\" & "Attachments"
DirName = Dir(DirPath, vbDirectory) ' Retrieve the first entry.
If DirName <> "" And bolTemp = True Then
varMsg = Cap11 ' Define message.
varStyle = vbYesNo + vbCritical + vbDefaultButton2 ' Define buttons.
varTitle = App.Title ' Define title.
' Display message.
varResponse = MsgBox(varMsg, varStyle, varTitle)
If varResponse = vbYes Then ' User chose Yes.
'Creates a new directory
MkDir App.Path & "\" & "NewAttachments"
bolTemp1 = False
Set oAttachments = oMsg.Attachments
For I = 1 To oAttachments.Count
If Not IsNull(oAttachments(I)) And oAttachments(I) <> "" Then
oAttachments(I).WriteToFile (App.Path & "\NewAttachments\" & oAttachments(I))
End If
Next I ' Perform some action.
Else ' User chose No.
Kill App.Path & "\" & "Attachments\*.*"
Set oAttachments = oMsg.Attachments
For I = 1 To oAttachments.Count
If Not IsNull(oAttachments(I)) And oAttachments(I) <> "" Then
oAttachments(I).WriteToFile (App.Path & "\Attachments\" & oAttachments(I))
End If
Next I
End If
bolTemp = False
Else
If bolTemp = True Then
'Creates a new directory
MkDir App.Path & "\" & "Attachments"
bolTemp = False
End If ' Perform some action.
Set oAttachments = oMsg.Attachments
For I = 1 To oAttachments.Count
If Not IsNull(oAttachments(I)) And oAttachments(I) <> "" And oAttachments(I) <> "Untitled Attachment" Then
If bolTemp1 = True Then
oAttachments(I).WriteToFile (App.Path & "\Attachments\" & oAttachments(I))
Else
oAttachments(I).WriteToFile (App.Path & "\NewAttachments\" & oAttachments(I))
End If
End If
Next I
End If
End If
'//***You can Uncomment this 2 line code if you want to set unread messages
'//***to read messages After store in database
'oMsg.Unread = False '// Please set the status of the unread email as false
'oMsg.Update '//Make sure we won't read same message twice
'//*******
End If
Set oMsg = oMessages.GetNext
Wend
Screen.MousePointer = vbDefault ' delivery is now complete so let them know
'Explicitly release objects.
oSession.Logoff
Set oSession = Nothing
Scusa guarda qui con ADO ...
http://www.freevbcode.com/ShowCode.Asp?ID=1914
Grazie 1000..