VB.NET SALVAR ANEXOS OUTLOOK

LEONARDOSILVEIR 20/08/2011 03:29:59
#382145
Pessoal, descbri no site [Ô]http://www.50minutos.com.br/blog/post/Salvar-anexos-do-Outlook-2007-usando-C.aspx[Ô] um programinha q faz a leitura dos anexos do email do outlook e salva em uma pasta, Porém este codigo está em C# fiz a conversao para vb.net, porém estou com problemas no codigo Dim myApp As Application = New ApplicationClass ocorrendo o erro (Error 1 Interop type [ô]ApplicationClass[ô] cannot be embedded. Use the applicable interface instead.)

segue abaixo o codigo completo, peço ajuda para corrigir o erro:

Imports System.Collections.Generic
Imports System.ComponentModel
Imports System.Data
Imports System.Drawing
Imports System.Linq
Imports System.Text
Imports SWF = System.Windows.Forms
Imports Microsoft.Office.Interop.Outlook
Imports System.Text.RegularExpressions

Partial Public Class Form1
Inherits SWF.Form

Public Sub New()
InitializeComponent()
End Sub


Private Sub Form1_Load(ByVal sender As Object, ByVal e As EventArgs)
Dim myApp As Application = New ApplicationClass
For Each f As Folder In myApp.GetNamespace([Ô]MAPI[Ô]).Folders
ListBox1.Items.Add(f.Name)
Next
ListBox1.SelectedIndex = 0
End Sub
Private Sub listBox1_SelectedIndexChanged(ByVal sender As Object, ByVal e As EventArgs)
If ListBox1.SelectedIndex <> -1 Then
ListBox2.Items.Clear()
Dim myApp As Application = New ApplicationClass
For Each f As Folder In myApp.GetNamespace([Ô]MAPI[Ô]).Folders(ListBox1.SelectedIndex + 1).Folders
ListBox2.Items.Add(f.Name)
Next
End If
End Sub
Private Sub listBox2_SelectedIndexChanged(ByVal sender As Object, ByVal e As EventArgs)
If SWF.MessageBox.Show([Ô]Tem certeza que quer salvar os anexos das mensagens selecionadas?[Ô] & vbLf & vbLf & [Ô]Isso apagará os anexos do seu e-mail!!![Ô], [Ô]Responda[Ô], SWF.MessageBoxButtons.YesNo, SWF.MessageBoxIcon.Question) = SWF.DialogResult.Yes Then
Dim myApp As Application = New ApplicationClass
For Each f As Folder In myApp.GetNamespace([Ô]MAPI[Ô]).Folders(ListBox1.SelectedIndex + 1).Folders
If f.Name.Equals(ListBox2.SelectedItem.ToString()) Then
For Each email As Object In (f.Items)
Dim mail As MailItem = TryCast(email, MailItem)
Dim contador As Integer
If mail IsNot Nothing Then
contador = 0
While mail.Attachments.Count > 0 AndAlso contador <= 10
Dim mi As Attachment = TryCast(mail.Attachments(1), Attachment)
If mi IsNot Nothing Then
Dim nomeAtt As String = Nothing
Try
nomeAtt = SWF.Application.StartupPath + [Ô]\[Ô] + f.Name & [Ô]_[Ô] & mail.SentOn.ToString([Ô]yyyyMMddHHmmss[Ô]) & [Ô]_[Ô] & Limpar(mail.Subject) & [Ô]_[Ô] & Limpar(mi.DisplayName)
mi.SaveAsFile(nomeAtt)
Label1.Text = mi.DisplayName
SWF.Application.DoEvents()
mi.Delete()
Catch
contador += 1
End Try
End If
End While
If mail IsNot Nothing Then
mail.Save()
End If
End If
Next
If SWF.MessageBox.Show([Ô]Arquivos gravados - quer abrir a pasta?[Ô], [Ô]FIM DO PROCESSO[Ô], SWF.MessageBoxButtons.YesNo, SWF.MessageBoxIcon.Question) = SWF.DialogResult.Yes Then
System.Diagnostics.Process.Start(SWF.Application.StartupPath)
SWF.Application.[Exit]()
End If
End If
Next
End If
End Sub
Private Function Limpar(ByVal s As [String]) As [String]
Return Regex.Replace(s, [Ô][[Ô][Ô]@/{}<>():|;\?*&%$][Ô], [String].Empty)
End Function

End Class
ALTAIR148 20/08/2011 07:40:07
#382147 Resposta escolhida
Bom dia,

Referencia o Imports Microsoft.Office.Interop.Outlook, testei aqui e o erro sumiu

Até mais.
ALTAIR148 20/08/2011 07:53:35
#382148
Bom dia,

Testei ele aqui e importa tudo mesmo do outlook.

Abraços...
LEONARDOSILVEIR 20/08/2011 10:30:17
#382153
Fiz a referencia, porém nao resolveu, poderia anexar o projeto no post?
ALTAIR148 20/08/2011 10:47:51
#382156
Segue o anexo. Vc tem que referenciar o Imports Microsoft.Office.Interop.Outlook versão 12.0.0.0

Até mais.
Tópico encerrado , respostas não são mais permitidas
Voltar