[Resolvido]Abrindo Pasta Específica No Outlook

Pessoal,
Bom dia a todos há algum tempo pedi aos amigos que me ajudassem sobre abrir uma pasta no Outlook, no que fui prontamente atendido, Mestre Vieira me mandou um código do Jpaulo, que agora preciso usar mas não sei como implementar. Usando o assitente de importação do Access os dados só são atualizados se antes o Outlook for aberto.
Preciso que sempre que chegar nova mensagem na pasta específica imediatamente atualize a tabela no Access.
Agradeço a ajuda.

Gerson

não estou a ver qual o codigo que está a utilizar.

mas se você quer que cada email novo vá direto para a sua tabela no banco, mesmo estando ele fechado, terá de inserir um codigo no proprio VBA do Outlook.

Olá Ricardo,
Vieira me mandou este código do Jpaulo, mas não sei como aproveitá-lo
Pode me ajudar ??

Obrigado
Public Function Outlook_Contacts_2_Access()


On Error GoTo No_Bugs


Dim CnnA As ADODB.Connection
Dim goRs As ADODB.Recordset


Dim oApp As Outlook.Application
Dim oNS As Outlook.NameSpace

Dim oInbox As Outlook.MAPIFolder

Dim oEmail As Outlook.MailItem


Dim i As Integer



Set oApp = New Outlook.Application

Set oNS = oApp.GetNamespace("MAPI")

Set oInbox = oNS.GetDefaultFolder(olFolderInbox)



Dim sSQL As String



Set CnnA = New ADODB.Connection

Set goRs = New ADODB.Recordset

'YOU WILL NEED TO CREATE YOUR TABLE IN ACCESS TO MATCH AND CALL IT INBOX

sSQL = "SELECT * FROM [Inbox] WHERE 1=2;"

goRs.Open sSQL, CnnA, adOpenKeyset, adLockOptimistic, adCmdText



frmMain.prbProgress.Max = oInbox.Items.Count

i = 1

Do While i <= oInbox.Items.Count

Set oEmail = oInbox.Items(i)

DoEvents

goRs.AddNew

goRs!To = oEmail.To

goRs!CC = oEmail.CC

goRs!BCC = oEmail.BCC

goRs!Subject = oEmail.Subject

goRs!Body = oEmail.Body
goRs!HTMLBody = oEmail.HTMLBody

goRs!Importance = oEmail.Importance

goRs!Received = oEmail.ReceivedTime

goRs!MessageClass = oEmail.MessageClass 'EMAIL, MEETING RESPONSE, MEETING REQUEST, ETC.

goRs!ReceivedByName = oEmail.ReceivedByName

'CONTINUE ON WITH OTHER FIELDS YOU WANT

'...
goRs.Update

Set oEmail = Nothing

frmMain.prbProgress.Value = i

i = i + 1

Loop

Set oEmail = Nothing

Set oInbox = Nothing

Set oNS = Nothing

goRs.Close
Set CnnA = Nothing

Set goRs = Nothing

Exit Function

No_Bugs:



MsgBox Err.Number & "-" & Err.Description, vbCritical, "Outlook Email Export"

Resume Next

End Function

Para abrir Pastas do Outlook

On Error GoTo StartError
Dim mOutlookApp As Outlook.Application
Dim mNameSpace As Outlook.NameSpace
Set mOutlookApp = New Outlook.Application
Set mNameSpace = mOutlookApp.GetNamespace("MAPI")
mNameSpace.GetDefaultFolder(olFolderCalendar).Display
Set mNameSpace = Nothing
Set mOutlookApp = Nothing
Exit Sub
StartError:
MsgBox "Error: " & Err & " " & Error
Exit Sub
.....................................................
On Error GoTo StartError
Dim objOutlook As Object
Dim objItem As Object
'Create a Microsoft Outlook object.
Set objOutlook = CreateObject("Outlook.Application")
'Create and open a new contact form for input.
Set objItem = objOutlook.CreateItem(olContactItem)

objItem.Display
'Quit Microsoft Outlook.
Set objOutlook = Nothing

Exit Sub
StartError:
MsgBox "Error: " & Err & " " & Error
Exit Sub
..........................................

On Error GoTo StartError
Dim objOutlook As Object
Dim objItem As Object
'Create a Microsoft Outlook object.
Set objOutlook = CreateObject("Outlook.Application")
'Create and open a new contact form for input.
Set objItem = objOutlook.CreateItem(olMailItem)


objItem.Display
'Quit Microsoft Outlook.
Set objOutlook = Nothing

Exit Sub
StartError:
MsgBox "Error: " & Err & " " & Error
Exit Sub
..................................................
On Error GoTo StartError
Dim objOutlook As Object
Dim objItem As Object
'Create a Microsoft Outlook object.
Set objOutlook = CreateObject("Outlook.Application")
'Create and open a new contact form for input.
Set objItem = objOutlook.CreateItem(olNoteItem)

objItem.Display
'Quit Microsoft Outlook.
Set objOutlook = Nothing

Exit Sub
StartError:
MsgBox "Error: " & Err & " " & Error
Exit Sub
.............................................
On Error GoTo StartError
Dim objOutlook As Object
Dim objItem As Object
'Create a Microsoft Outlook object.
Set objOutlook = CreateObject("Outlook.Application")
'Create and open a new contact form for input.
Set objItem = objOutlook.CreateItem(olTaskItem)

objItem.Display
'Quit Microsoft Outlook.
Set objOutlook = Nothing

Exit Sub
StartError:
MsgBox "Error: " & Err & " " & Error
Exit Sub
.........................................
On Error GoTo StartError
Dim objOutlook As Object
Dim objItem As Object
'Create a Microsoft Outlook object.
Set objOutlook = CreateObject("Outlook.Application")
'Create and open a new contact form for input.
Set objItem = objOutlook.CreateItem(olAppointmentItem)


objItem.Display
'Quit Microsoft Outlook.
Set objOutlook = Nothing

Exit Sub
StartError:
MsgBox "Error: " & Err & " " & Error
Exit Sub

Olá Vieira,

Vamos lá ! como fazer ?
Crio um formulário e coloco um botão de comando ?
Preciso criar uma tabela para guardar os dados ?
Se tiver tempo me de o caminho das pedras.
Abraços,

Para aceder a cada um desses códigos tem que ter um botão de comando para cada um. Agora a importação do Outlook para Access nunca fiz, pois nunca precisei, mas existem rotinas para isso como já referiu o colega Ricardo.

Se eu vincular uma pasta do outlook só após visualizar os email no p´roprio outlook é que o email fica disponível no Access, se for possivel como fazer a rotina inversa ou seja outlook para Access ?

Amigo Gerson

Veja se ajuda

http://support.microsoft.com/kb/290792

Vieira agora estou saindo do trabalho amanhã vou tentar e te darei um retorno.
Abraços boa noite e até amanhã.

Gerson

OK, fico no aguardo.

aproveite e veja este tambem

http://www.blueclaw-db.com/read_email_access_outlook.htm

ou este tambem excelente

http://www.fabalou.com/Access/Modules/reading_email.asp

Amigão

Veja esta BD que importa do outlook para o access. Explore bem.

Abraço

Amigos,

Pelo que eu entendi, ele quer que seu aplicativo baixe as

novas mensagens do outlook, sem abrir o mesmo.

Isso pra mim ainda é um sonho. rssssss

Sds,

nada é impossivel no Office

o outlook funciona com o mesmo VBA que o ms Access

Com o outlook aberto é só pressionar Alt+F11 e inserir um novo modulo, aí é só colar as funções e testar.

esta é uma delas
http://www.techrepublic.com/blog/howdoi/how-do-i-export-e-mail-messages-to-access-using-vba/119

e aqui um tutorial de funcionamento do VBA no outlook
http://msdn.microsoft.com/en-us/library/aa218785.aspx

Bom dia Ricardo,

Desculpe se não fiz entender.

O que eu quiz dizer, é que podemos usar todas as

funções do Outlook pelo access, mas fazer com que

ele baixe as novas mensagens do servidor POP3 sem

que seja aberto para fazer o processo POP3 e SMTP

eu desconheço.

Já vi rotinas em Shell Script no Linux que fazem isso,

mas em Windows, não tenho conhecimento.

Sds,

Bom dia Pessoal,
O exemplo enviado pelo Vieira funciona mas para a minha tristeza não pude testar pois precisei fazer uma alteração no meu servidor de email. (meu servidor orientou que eu trocasse de pop para imap) isso fez com que o meu outlook criasse uma cópia da caixa de entrada e é através dessa cópia que eu tenho acesso aos dados. Aí é que vem o problema...
1 - No BD enviado pelo Vieira como apontar a pasta que eu preciso
Obrigado pela força.

http://maximoaccess.forumeiros.com/download.forum?id=274

Gerson

Eu estive a estudar o exemplo e ele abre através do Perfil do Utilizador e vai para a pasta a receber. Não vejo maneira de alterar isso. Qual o nome da Pasta actual?

Vieira,
Voce parece ser uma espécie de anjo da guarda. No seu exemplo não pude estabelecer a pasta padrao por problemas com meu provedor, mas se alterarmos o caminho acho que pode funcionar.
Vou tentar mandar a configuração como ficou meu outlook...

A pasta atual é imap.ig.com.br/todos os emails
Como postei a
meu provedor me conduziu a trocar de pop para imap, repare pelo que observei no seu exemplo a questão é somente do caminho,
contudo pela minha limitação em VBA não sei como fazer.

http://dl.dropbox.com/u/13553076/Pastas%20Outlook.bmp

Teste alterando esta linha

Private Function ScanInbox(SubjectLine As String)
Dim TempRst As Recordset
Dim OlApp As Outlook.Application
Dim Inbox As Outlook.MAPIFolder
Dim InboxItems As Outlook.Items
Dim Mailobject As Object
Set OlApp = CreateObject("Outlook.Application")
Set Inbox = OlApp.GetNamespace("Mapi").GetFolder(imap.ig.com.br)
Set TempRst = CurrentDb.OpenRecordset("tbl_OutlookTemp")
If SubjectLine <> "" Then
Set InboxItems = Inbox.Items.Restrict("[Subject] = """ & SubjectLine & """")
Else
Set InboxItems = Inbox.Items
End If
For Each Mailobject In InboxItems
With TempRst
On Error Resume Next
.AddNew
!Subject = Mailobject.Subject
!From = Mailobject.SenderName
!To = Mailobject.To
!BOdy = Mailobject.BOdy
!DateSent = Mailobject.SentOn
.Update
'Mailobject.Read = True
End With
Next

Set OlApp = Nothing
Set Inbox = Nothing
Set InboxItems = Nothing
Set Mailobject = Nothing
Set TempRst = Nothing
End Function

Vieira,
Dá um erro de variavel não definida

Pois, eu não tenho aqui condições para testar pois as minhas configurações são diferentes e não utilizo o Outlook como gestor de correio.

Vamos só tornar essa Pasta como defeito para ver se assim funciona

Set Inbox = OlApp.GetNamespace("Mapi").GetDefaultFolder(imap.ig.com.br)

Infelizmente permanece o erro de variavel não definida, Vieira obrigado preciso sair amanhã entro em contato bom domingo amigo bom descanço até amanhã,
Abraços

Bom dia Gerson,

O Outlook não está achando o caminho da pasta.

O codigo que vou disponibilizar abaixo, gera um arquivo txt mas vc pode adaptar para escrever em uma tabela.

Marque a referência VBScript Regular Expressions 5.5

Cole este Codigo em um novo modulo:

Código:

Public Sub ImportaEmail()

    Dim objApp As Outlook.Application
    Dim objItem As Outlook.MailItem
    Dim inbox As Object
    Dim olNamespace As Outlook.NameSpace
    Dim SndName As String, SndAddr As String, ToName As String, CCName As String
    Dim Subj As String, Rcvd As String, MsgBody As String, AtchName As String
    Dim saida As String
    'limpar_txt
   
    Set objApp = New Outlook.Application
    Set olNamespace = objApp.GetNamespace("MAPI")

       
  For Each objItem In olNamespace.Folders("Pastas Particulares").Folders("Caixa de Entrada").Folders("imap.ig.com.br").Items
   
    If objItem.Class = olMail Then
       
            With objItem
                SndName = .SenderName
                SndAddr = .SenderEmailAddress
                ToName = .To
                CCName = .CC
                Subj = .Subject
                MsgBody = .HTMLBody
                Rcvd = .ReceivedTime
           
            End With
   
     
Dim RegularExpressionObject As Object

Set RegularExpressionObject = New VBScript_RegExp_55.RegExp

With RegularExpressionObject
.Pattern = "<[^>]+>"
.IgnoreCase = True
.Global = True
End With


MsgBody = RegularExpressionObject.Replace(MsgBody, "" & vbCrLf)

Open "C:\txtemp.txt" For Append As #1

Set RegularExpressionObject = Nothing
Print #1, MsgBody
Close #1
End If

Next


 Set objItem = Nothing
    Set objApp = Nothing
End Sub


No evento ao clicar do botão escreva:

ImportaEmail

Sds,

Olá, Pessoal
Chsestrem
não tenho na minha máquina a bliblioteca como conseguir ? VBScript Regular Expressions 5.5 ??

Chsestrem,
Reinstalei o office e consegui acesso a bliblioteca, o caso é que estou agora na máquina do trabalho, e para usar o seu exemplo terei que testar em casa ou se tiver tempo diga qual a linha a alterar para usar a pasta padrão
à noite testarei em casa e darei retorno.
Abraços
Gerson

Ja coloquei a subpasta que vc comentou nesta linha:

For Each objItem In olNamespace.Folders("Pastas Particulares").Folders("Caixa de Entrada").Folders("imap.ig.com.br").Items

Na linha: Print #1, MsgBody eu coloquei apenas o corpo da mensagem.

Vc pode colocar as variaveis que estão no bloco With que precisar nesta linha. Ex:

Print #1, ToName, CCName, Subj, MsgBody

Sds,

Qualquer coisa dá um help.

Chsestrem,
A linha (For Each objItem In olNamespace.Folders("Pastas Particulares").Folders("Caixa de Entrada").Folders("imap.ig.com.br").Items) eu vou usar só em casa no trabalho a pasta onde estão as mensagens e a padrão o que eu preciso eliminar para fazer um teste agora com a pasta padrão ??

No seu trabalho, se for a Caixa de Entrada, pode ser

For Each objItem In olNamespace.Folders("Pastas Particulares").Folders("Caixa de entrada").Items

No trabalho dá erro e para nesta linha:


Next


Set objItem = Nothing
Set objApp = Nothing
End Sub

Vc está com a referencia do Outlook marcada?

Talvez a linha seja assim apenas com as pastas particulares:

For Each objItem In olNamespace.Folders("Pastas Particulares").Items


Sds

Ola Pessoal são 07:14 chsestrem, testei as modificações, mas não gerei o arquivo de texto eu tenho que criar alguma tabela ? desculpe se não entendi direito... a unica coisa que acontece quando clico no botão e aparecer o logo do otlook.

Não precisa criar nada.

Se não deu erro, gerou o txt em C:\txtemp.txt

Eureka !!!!!!!!!!!!!
Só preciso agora editar o txt para que venha em formato de tabela e verificar se a atualização está de forma automática. Se não for pedir muito me ajude ...
Abraços,
Gerson

Olá Gerson,

Sugiro que coloque este tópico como [resolvido], pois a sua

dúvida agora é outra.

Concerteza muitos de nossos membros irão ajudá-lo OK

Sds,

Amigo Gerson

Faça como o Charles diz. Abra um novo tópico porque este já está muito grande e acaba confundindo. Se o assunto é outro, agradeço então essa gentileza. Dou o tópico por resolvido.

Obrigado ao Charles e ao Ricardo pelo empenhamento neste tópico que não foi nada fácil de resolver.

Olá, Gerson!

Poderia indicar qual o procedimento para salvar estes dados para uma tabela?

Gumz,
Abra um novo tópico por favor.
Abraços,
Gerson