Enlazar access con groupwise
Como puedo desde un formulario access lanzar una tarea en Groupwise
Y tambiem como puedo enviar un informe como cuerpo del mensaje.
Y tambiem como puedo enviar un informe como cuerpo del mensaje.
1 Respuesta
Respuesta de luis45ccs
0
0
luis45ccs, Realizo sistemas en access y vb independientemente
No conozco Groupwise
Pero puedes ejecutar programas con shell
Para lo segundo, puedes sacar el reporte en snapshot y enviarlo por email
o mas automatico, estudiando la programacion del servidor de correo, como outlook
como estas
Public Sub SendMessage(Optional AttachmentPath)
Dim objOutlook As Outlook.Application
Dim objOutlookMsg As Outlook.MailItem
Dim objOutlookRecip As Outlook.Recipient
Dim objOutlookAttach As Outlook.Attachment
'Dim MyAddressList As Outlook.AddressLists
'Dim MyAddressEntry As Outlook.AddressEntry
'Set MyOutlook = New Outlook.Application
'Set MyMail = MyOutlook.CreateItem(olMailItem)
'Dim inBox As Outlook.MAPIFolder
'inBox = Me.Application.Session.GetDefaultFolder(Outlook.OlDefaultFolders.olFolderInbox)
'Dim unreadItems As Outlook.Items
'unreadItems = inBox.Items.Restrict("[Unread]=true")
'MessageBox.Show(String.Format("Unread items in Inbox = {0}", unreadItems.Count))
' Create the Outlook session.
'Shell ("c:\archivos de programa\microsoft Office\Office12\outlook.exe")
Set objOutlook = CreateObject("Outlook.Application")
' Create the message.
Set objOutlookMsg = objOutlook.CreateItem(olMailItem)
With objOutlookMsg
' Add the To recipient(s) to the message.
If Emp = "" Then Emp = DLookup("Código", "Empresas")
Set objOutlookRecip = .Recipients.Add(DLookup("[Email para envios]", "Empresas", "Código='" & Emp & "'"))
objOutlookRecip.Type = olTo
' Add the CC recipient(s) to the message.
'Set objOutlookRecip = .Recipients.Add("Andrew Fuller")
'objOutlookRecip.Type = olCC
' Set the Subject, Body, and Importance of the message.
.Subject = DLookup("Asunto", "Empresas", "Código='" & Emp & "'")
.Body = ""
.Importance = olImportanceHigh 'High importance
' Add attachments to the message.
If Not IsMissing(AttachmentPath) Then
Set objOutlookAttach = .Attachments.Add(AttachmentPath)
End If
' Resolve each Recipient's name.
For Each objOutlookRecip In .Recipients
objOutlookRecip.Resolve
If Not objOutlookRecip.Resolve Then objOutlookMsg.Display
Next
.Send
End With
Set objOutlookMsg = Nothing
Set objOutlook = Nothing
End Sub
Sub Test_mail()
Dim MyOutlook As Outlook.Application
Dim MyNameSpace As NameSpace
Dim MyAddrList As AddressList
Dim MyDistList As AddressEntry
Dim MyListMember As AddressEntry
Dim MyMail As Outlook.MailItem
Dim MyRecipient As Outlook.Recipient
Dim sUserName As String
' ---- Connect to Outlook
Set MyOutlook = New Outlook.Application
Set MyNameSpace = MyOutlook.GetNamespace("MAPI")
Set MyAddrList = MyNameSpace.AddressLists("Global Address List")
' ---- User name parameter
sUserName = "[email protected]" 'GetUserNameFromForm()
' ---- Set up mail item & resolve supplied name
Set MyMail = MyOutlook.CreateItem(olMailItem)
MyMail.Recipients.Add (sUserName)
MyMail.Recipients.ResolveAll
Set MyRecipient = MyMail.Recipients.Item(1)
If Not MyRecipient.Resolved Then
MsgBox "Please choose a valid name"
Exit Sub
End If
' ---- What is available in the distribution list
Set MyDistList = MyAddrList.AddressEntries(MyRecipient.Name)
' ---- CC the manager if present
If Not MyDistList.Manager Is Nothing Then
MyMail.CC = MyDistList.Manager
End If
' ---- Resolve a single entry or a distribution list
If MyDistList.Members Is Nothing Then
MsgBox MyDistList.Name & ", " & IIf(Not MyDistList.Manager Is Nothing, MyDistList.Manager, "")
Else
For Each MyListMember In MyDistList.Members
MsgBox MyListMember.Name & ", " & IIf(Not MyListMember.Manager Is Nothing, MyListMember.Manager, "")
Next
End If
MyMail.Subject = "Subject line"
MyMail.Body = "Multiple line " & vbCrLf & "body"
MyMail.Display
Set MyListMember = Nothing
Set MyDistList = Nothing
Set MyRecipient = Nothing
Set MyMail = Nothing
Set MyAddrList = Nothing
Set MyNameSpace = Nothing
Set MyOutlook = Nothing
End Sub
'Private Sub ThisAddIn_Startup(ByVal sender As Object, ByVal e As System.EventArgs) ' Handles Me.Startup
' Dim inbox As Outlook.MAPIFolder = _
' Me.Application.Session.GetDefaultFolder(Outlook.OlDefaultFolders.olFolderInbox)
'
' Dim unreadItems As Outlook.Items = _
' inbox.Items.Restrict("[Unread]=true")
'
' MessageBox.Show( _
' String.Format("Unread items in Inbox = {0}", unreadItems.Count))
'End Sub
Public Sub ThisAddIn_NewMail() ' Handles Application.NewMail
Dim inBox As Outlook.MAPIFolder
Dim inBoxItems As Outlook.Items
Dim newEmail As Outlook.MailItem
Dim collectionItem As Object
' inBox = Application..ActiveExplorer().Session.GetDefaultFolder(Outlook.OlDefaultFolders.olFolderInbox)
inBoxItems = inBox.Items
inBoxItems = inBoxItems.Restrict("[Unread] = true")
'Try
For Each collectionItem In inBoxItems
' newEmail = TryCast(collectionItem, Outlook.MailItem)
' If newEmail IsNot Nothing Then
If newEmail.Attachments.Count > 0 Then
' For i As Integer = 1 To newEmail.Attachments.Count
' Dim saveAttachment As Outlook.Attachment = _
newEmail.Attachments(i)
newEmail.Attachments(i).SaveAsFile _
("C:\TestFileSave\" & (newEmail _
.Attachments(i).FileName))
' Next i
End If
' End If
Next collectionItem
'Catch ex As Exception
' If Left(ex.Message, 11) = "Cannot save" Then
' MessageBox.Show ("Create Folder C:\TestFileSave")
' End If
'End Try
End Sub
Public Sub ReciboMail()
On Error GoTo ReciboMail_Err
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) 'olContactItem)
Set objOutlook = Outlook.Application
Set MyNameSpace = objOutlook.GetNamespace("MAPI")
Set myFolder = MyNameSpace.GetDefaultFolder(olFolderInbox)
'myFolder.Display
If Emp = "" Then Emp = DMax("Código", "Empresas")
Asunto = DLookup("[Asunto]", "Empresas", "Código='" & Emp & "'")
'Set myItem = myFolder.Items(Asunto)
ReciboMailOtro:
sw = 0
For a = 1 To myFolder.Items.Count
Set myItem = myFolder.Items(a)
'Debug.Print myItem.Subject
If InStr(myItem.Subject, Asunto) Then
If myItem.Attachments.Count > 0 Then
If myItem.Attachments(1) = "Envio.zip" Then
myItem.Attachments.Item(1).SaveAsFile "C:\Archivos de programa\SigInve\Envio.zip"
'myItem.Attachments.Item(1).DisplayName
sw = 1
End If
If myItem.Attachments(1) = "Envio.sof" Then
myItem.Attachments.Item(1).SaveAsFile "C:\Archivos de programa\SigInve\Envio.sof"
'myItem.Attachments.Item(1).DisplayName
sw = 1
End If
Shell "C:\archivos de programa\SigInve\Recibo.bat", vbNormalFocus
re = MsgBox("Archivo Recibido Descomprimiendo...." & Chr$(13) & "Espere hasta que el recuadro" & Chr$(13) & "negro se cierre y presione OK")
'SendMessage ("C:\archivos de programa\SigInve\Envio.zip")
Dim r As Recordset
Set r = CurrentDb.OpenRecordset("Select * from Archivos order by Código")
If r.RecordCount > 0 Then
r.MoveLast
r.MoveFirst
For ar = 1 To r.RecordCount
AgregarRegistro "C:\Archivos de programa\SigInve\Envio.sof", "", "Envio" & r!Nombre, r!Nombre
r.MoveNext
Next
End If
'AgregarRegistro "EnvioVentas", "Ventas"
'AgregarRegistro "EnvioMovimientos de Ventas", "Movimientos de Ventas"
'AgregarRegistro "EnvioCobros", "Cobros"
re = MsgBox("Trabajo completado" & Chr$(13) & "Desea Borrar el email", vbYesNo)
If re = vbYes Then
myItem.Delete
GoTo ReciboMailOtro
End If
End If
End If
If a > myFolder.Items.Count Then Exit For
Next
If sw = 0 Then MsgBox ("No hay mas mail con el asunto: " & Asunto)
'To create a new appointment, journal entry, email message, note, post,
'or task, replace olContactItem above with one of the following:
'
' Appointment = olAppointmentItem
'Journal Entry = olJournalItem
'Email Message = olMailItem
' Note = olNoteItem
' Post = olPostItem
' Task = olTaskItem
'objItem.Display
'Quit Microsoft Outlook.
Set objOutlook = Nothing
Exit Sub
ReciboMail_Err:
MsgBox "Error: " & Err & " " & Error
If Err = 462 Then Exit Sub
Resume Next
Exit Sub
End Sub
Pero puedes ejecutar programas con shell
Para lo segundo, puedes sacar el reporte en snapshot y enviarlo por email
o mas automatico, estudiando la programacion del servidor de correo, como outlook
como estas
Public Sub SendMessage(Optional AttachmentPath)
Dim objOutlook As Outlook.Application
Dim objOutlookMsg As Outlook.MailItem
Dim objOutlookRecip As Outlook.Recipient
Dim objOutlookAttach As Outlook.Attachment
'Dim MyAddressList As Outlook.AddressLists
'Dim MyAddressEntry As Outlook.AddressEntry
'Set MyOutlook = New Outlook.Application
'Set MyMail = MyOutlook.CreateItem(olMailItem)
'Dim inBox As Outlook.MAPIFolder
'inBox = Me.Application.Session.GetDefaultFolder(Outlook.OlDefaultFolders.olFolderInbox)
'Dim unreadItems As Outlook.Items
'unreadItems = inBox.Items.Restrict("[Unread]=true")
'MessageBox.Show(String.Format("Unread items in Inbox = {0}", unreadItems.Count))
' Create the Outlook session.
'Shell ("c:\archivos de programa\microsoft Office\Office12\outlook.exe")
Set objOutlook = CreateObject("Outlook.Application")
' Create the message.
Set objOutlookMsg = objOutlook.CreateItem(olMailItem)
With objOutlookMsg
' Add the To recipient(s) to the message.
If Emp = "" Then Emp = DLookup("Código", "Empresas")
Set objOutlookRecip = .Recipients.Add(DLookup("[Email para envios]", "Empresas", "Código='" & Emp & "'"))
objOutlookRecip.Type = olTo
' Add the CC recipient(s) to the message.
'Set objOutlookRecip = .Recipients.Add("Andrew Fuller")
'objOutlookRecip.Type = olCC
' Set the Subject, Body, and Importance of the message.
.Subject = DLookup("Asunto", "Empresas", "Código='" & Emp & "'")
.Body = ""
.Importance = olImportanceHigh 'High importance
' Add attachments to the message.
If Not IsMissing(AttachmentPath) Then
Set objOutlookAttach = .Attachments.Add(AttachmentPath)
End If
' Resolve each Recipient's name.
For Each objOutlookRecip In .Recipients
objOutlookRecip.Resolve
If Not objOutlookRecip.Resolve Then objOutlookMsg.Display
Next
.Send
End With
Set objOutlookMsg = Nothing
Set objOutlook = Nothing
End Sub
Sub Test_mail()
Dim MyOutlook As Outlook.Application
Dim MyNameSpace As NameSpace
Dim MyAddrList As AddressList
Dim MyDistList As AddressEntry
Dim MyListMember As AddressEntry
Dim MyMail As Outlook.MailItem
Dim MyRecipient As Outlook.Recipient
Dim sUserName As String
' ---- Connect to Outlook
Set MyOutlook = New Outlook.Application
Set MyNameSpace = MyOutlook.GetNamespace("MAPI")
Set MyAddrList = MyNameSpace.AddressLists("Global Address List")
' ---- User name parameter
sUserName = "[email protected]" 'GetUserNameFromForm()
' ---- Set up mail item & resolve supplied name
Set MyMail = MyOutlook.CreateItem(olMailItem)
MyMail.Recipients.Add (sUserName)
MyMail.Recipients.ResolveAll
Set MyRecipient = MyMail.Recipients.Item(1)
If Not MyRecipient.Resolved Then
MsgBox "Please choose a valid name"
Exit Sub
End If
' ---- What is available in the distribution list
Set MyDistList = MyAddrList.AddressEntries(MyRecipient.Name)
' ---- CC the manager if present
If Not MyDistList.Manager Is Nothing Then
MyMail.CC = MyDistList.Manager
End If
' ---- Resolve a single entry or a distribution list
If MyDistList.Members Is Nothing Then
MsgBox MyDistList.Name & ", " & IIf(Not MyDistList.Manager Is Nothing, MyDistList.Manager, "")
Else
For Each MyListMember In MyDistList.Members
MsgBox MyListMember.Name & ", " & IIf(Not MyListMember.Manager Is Nothing, MyListMember.Manager, "")
Next
End If
MyMail.Subject = "Subject line"
MyMail.Body = "Multiple line " & vbCrLf & "body"
MyMail.Display
Set MyListMember = Nothing
Set MyDistList = Nothing
Set MyRecipient = Nothing
Set MyMail = Nothing
Set MyAddrList = Nothing
Set MyNameSpace = Nothing
Set MyOutlook = Nothing
End Sub
'Private Sub ThisAddIn_Startup(ByVal sender As Object, ByVal e As System.EventArgs) ' Handles Me.Startup
' Dim inbox As Outlook.MAPIFolder = _
' Me.Application.Session.GetDefaultFolder(Outlook.OlDefaultFolders.olFolderInbox)
'
' Dim unreadItems As Outlook.Items = _
' inbox.Items.Restrict("[Unread]=true")
'
' MessageBox.Show( _
' String.Format("Unread items in Inbox = {0}", unreadItems.Count))
'End Sub
Public Sub ThisAddIn_NewMail() ' Handles Application.NewMail
Dim inBox As Outlook.MAPIFolder
Dim inBoxItems As Outlook.Items
Dim newEmail As Outlook.MailItem
Dim collectionItem As Object
' inBox = Application..ActiveExplorer().Session.GetDefaultFolder(Outlook.OlDefaultFolders.olFolderInbox)
inBoxItems = inBox.Items
inBoxItems = inBoxItems.Restrict("[Unread] = true")
'Try
For Each collectionItem In inBoxItems
' newEmail = TryCast(collectionItem, Outlook.MailItem)
' If newEmail IsNot Nothing Then
If newEmail.Attachments.Count > 0 Then
' For i As Integer = 1 To newEmail.Attachments.Count
' Dim saveAttachment As Outlook.Attachment = _
newEmail.Attachments(i)
newEmail.Attachments(i).SaveAsFile _
("C:\TestFileSave\" & (newEmail _
.Attachments(i).FileName))
' Next i
End If
' End If
Next collectionItem
'Catch ex As Exception
' If Left(ex.Message, 11) = "Cannot save" Then
' MessageBox.Show ("Create Folder C:\TestFileSave")
' End If
'End Try
End Sub
Public Sub ReciboMail()
On Error GoTo ReciboMail_Err
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) 'olContactItem)
Set objOutlook = Outlook.Application
Set MyNameSpace = objOutlook.GetNamespace("MAPI")
Set myFolder = MyNameSpace.GetDefaultFolder(olFolderInbox)
'myFolder.Display
If Emp = "" Then Emp = DMax("Código", "Empresas")
Asunto = DLookup("[Asunto]", "Empresas", "Código='" & Emp & "'")
'Set myItem = myFolder.Items(Asunto)
ReciboMailOtro:
sw = 0
For a = 1 To myFolder.Items.Count
Set myItem = myFolder.Items(a)
'Debug.Print myItem.Subject
If InStr(myItem.Subject, Asunto) Then
If myItem.Attachments.Count > 0 Then
If myItem.Attachments(1) = "Envio.zip" Then
myItem.Attachments.Item(1).SaveAsFile "C:\Archivos de programa\SigInve\Envio.zip"
'myItem.Attachments.Item(1).DisplayName
sw = 1
End If
If myItem.Attachments(1) = "Envio.sof" Then
myItem.Attachments.Item(1).SaveAsFile "C:\Archivos de programa\SigInve\Envio.sof"
'myItem.Attachments.Item(1).DisplayName
sw = 1
End If
Shell "C:\archivos de programa\SigInve\Recibo.bat", vbNormalFocus
re = MsgBox("Archivo Recibido Descomprimiendo...." & Chr$(13) & "Espere hasta que el recuadro" & Chr$(13) & "negro se cierre y presione OK")
'SendMessage ("C:\archivos de programa\SigInve\Envio.zip")
Dim r As Recordset
Set r = CurrentDb.OpenRecordset("Select * from Archivos order by Código")
If r.RecordCount > 0 Then
r.MoveLast
r.MoveFirst
For ar = 1 To r.RecordCount
AgregarRegistro "C:\Archivos de programa\SigInve\Envio.sof", "", "Envio" & r!Nombre, r!Nombre
r.MoveNext
Next
End If
'AgregarRegistro "EnvioVentas", "Ventas"
'AgregarRegistro "EnvioMovimientos de Ventas", "Movimientos de Ventas"
'AgregarRegistro "EnvioCobros", "Cobros"
re = MsgBox("Trabajo completado" & Chr$(13) & "Desea Borrar el email", vbYesNo)
If re = vbYes Then
myItem.Delete
GoTo ReciboMailOtro
End If
End If
End If
If a > myFolder.Items.Count Then Exit For
Next
If sw = 0 Then MsgBox ("No hay mas mail con el asunto: " & Asunto)
'To create a new appointment, journal entry, email message, note, post,
'or task, replace olContactItem above with one of the following:
'
' Appointment = olAppointmentItem
'Journal Entry = olJournalItem
'Email Message = olMailItem
' Note = olNoteItem
' Post = olPostItem
' Task = olTaskItem
'objItem.Display
'Quit Microsoft Outlook.
Set objOutlook = Nothing
Exit Sub
ReciboMail_Err:
MsgBox "Error: " & Err & " " & Error
If Err = 462 Then Exit Sub
Resume Next
Exit Sub
End Sub
- Compartir respuesta
- Anónimo
ahora mismo