VBA (Outlook) buscar correos nuevos e insertar en Access
Quisiera pedir de su acostumbrada ayuda.
Estoy creando un script en Outlook, que relice lo siguiente cada vez que llegue un nuevo correo:
1- Buscar una bandeja (Cada usuario tiene varios correos).
2- Entrar a la bandeja buscada("Bandeja de entrada").
3- Buscar si hay un nuevo correo.
4- Insertar toda la data del correo nuevo en una tabla Access que esta en una carpeta de red.
Tengo un pequeño avance, pero no he avanzado al ritmo que deseo.
Me ayudan por favor.
Private Sub Application_NewMailEx(ByVal EntryIDCollection As String)
Dim InxStoreCrnt As Integer
Dim NS As NameSpace
Dim StoresColl As Folders
Set NS = CreateObject("Outlook.Application").GetNamespace("MAPI")
Set StoresColl = NS.Folders
For InxStoreCrnt = 1 To StoresColl.Count
If StoresColl(InxStoreCrnt).Name = "[email protected]" Then
'-- Aquí deseo buscar el nuevo correo (si hay)
'-- Conectarme a una DB de Access en la red.
'-- Insertar en una tabla el nuevo correo.
End If
Next
End SubMuy agradecido por su enorme ayuda desde ya.
1 Respuesta
Respuesta de Carlos Dahbura
2
Quiero informar que he encontrado la forma de realizar la actividad y comparto el resultado por si alguien necesita también la respuesta:
Private Sub Application_NewMailEx(ByVal EntryIDCollection As String)
Dim StoresColl As Stores
Dim StoreCrnt As Store
Set StoresColl = Session.Stores
For Each StoreCrnt In StoresColl
If StoreCrnt.DisplayName = "Usuario buscado" Then
Dim Folder As Folder, Correos As Items, MiCorreo As MailItem
Set Folder = Session.folders("Usuario buscado").folders("Bandeja de entrada")
Set Correos = Folder.Items
Correos.Sort "ReceivedTime", True
Set MiCorreo = Correos.Item(1)
cAsunto = MiCorreo.Subject
cDe = MiCorreo.SenderName
cNombre_Remitente = MiCorreo.SenderName
cCC = MiCorreo.CC
cPara = MiCorreo.To
dRecibido = MiCorreo.ReceivedTime
dCreado = MiCorreo.ReceivedTime
dModificado = MiCorreo.ReceivedTime
Dim SQL As String
SQL = "INSERT INTO Tabla (Asunto, De, " & _
"Remitente, CC, Para, Recibido, Creado, Modificado) " & _
" SELECT " & _
"'" & cAsunto & "'," & _
"'" & cDe & "'," & _
"'" & cNombre_Remitente & "'," & _
"'" & cCC & "'," & _
"'" & cPara & "'," & _
"'" & dRecibido & "'," & _
"'" & dCreado & "'," & _
"'" & dModificado & "' " & _
"FROM (SELECT First(Id) From Dummy) Dummy " & _
"WHERE " & "'" & cAsunto & Left(dCreado, 10) & "'" & " NOT IN ( SELECT Key FROM Tabla) "
Dim Cnx As ADODB.Connection
Set Cnx = New ADODB.Connection
Cnx.Provider = "Microsoft.ACE.OLEDB.12.0"
Cnx.ConnectionString = "Ruta de Access"
Cnx.Open
Cnx.Execute SQL
End If
Next
End Sub
