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.

1 Respuesta

Respuesta
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
Gracias por la respuesta, para la aplicación que estoy haciendo actualmente no me vale
pero el contenido de la respuesta es interesante, como se suele decir el saber no ocupa 
lugar. Te puntuo regular simplemete por que no me es aplicable a mi base de datos.

Añade tu respuesta

Haz clic para o

Más respuestas relacionadas