[AccessD] Accessing qindows Send To

Mike and Doris Manning mikedorism at ntelos.net
Wed Jun 18 09:21:34 CDT 2003


You are basically going to have to build your own routine to handle the send
attachment process using the Outlook object model and/or CDO.  Slipstick's
website (http://www.slipstick.com/) has a lot of helpful tips and tricks.

We use Redemption (http://www.dimastr.com/redemption/) to get around the
Microsoft Outlook Security patch issues.  Our code looks something like
this...

   
Public Function SendSafeEmail(SendTo As String, SendSubj As String, _
                     SendBody As String, SendEdit As Boolean, _
                     Optional SendCC As String, _
                     Optional FilePath As String, _
                     Optional strAttach As String)
                                         
    On Error GoTo ErrorHandler
    
    Dim PullFile As String
    Dim oMail As Object
    Dim oSpace As Object
    Dim oFoldr As Object
    Dim oItem As Object
    Dim oSafe As Object
    Dim oRecip As Object
    Dim oDeliver As Object
    Dim bolOpen As Boolean
    Dim aryRecip() As String
    Dim intRecip As Integer
    Dim aryFileList() As String
    Dim intFilelist As Integer
    Dim strFileName As String
    Dim lcv As Integer
    
    bolOpen = IsOutlookOpen
    
    Set oMail = CreateObject("Outlook.Application")
    Set oSpace = oMail.GetNamespace("MAPI")
    Set oFoldr = oSpace.GetDefaultFolder(olFolderOutbox)
    Set oItem = oMail.CreateItem(olMailItem)
    Set oSafe = CreateObject("Redemption.SafeMailItem")
    oSafe.Item = oItem

    With oSafe
        'Add the TO names
        If SendTo <> vbNullString Then
            If InStr(1, SendTo, ";", vbTextCompare) > 0 Then
                If Right(SendTo, 1) <> ";" Then SendTo = SendTo & ";"
                aryRecip = Split(SendTo, ";")
                intRecip = UBound(aryRecip) - 1
                For lcv = 0 To intRecip
                    .Recipients.Add aryRecip(lcv)
                Next lcv
                Erase aryRecip
                .Recipients.ResolveAll
            Else
                .Recipients.Add SendTo
                .Recipients.ResolveAll
            End If
        End If
        'Add the CC names
        If SendCC <> vbNullString Then
            If InStr(1, SendCC, ";", vbTextCompare) > 0 Then
                If Right(SendTo, 1) <> ";" Then SendTo = SendTo & ";"
                aryRecip = Split(SendCC, ";")
                intRecip = UBound(aryRecip) - 1
                For lcv = 0 To intRecip
                    .Recipients.Add aryRecip(lcv)
                Next lcv
                .Recipients.ResolveAll
            Else
                .Recipients.Add SendCC
                .Recipients.ResolveAll
            End If
        End If
        
        'Add the rest of the information
        .Subject = SendSubj
        .Body = SendBody
        
        'Add Attachments
        If strAttach <> vbNullString Then
            If InStr(1, strAttach, ";", vbTextCompare) > 0 Then
                If Right(strAttach, 1) <> ";" Then
                    strAttach = strAttach & ";"
                End If
                aryFileList = Split(strAttach, ";")
                intFilelist = UBound(aryFileList) - 1
                For lcv = 0 To intFilelist
                    PullFile = CurrentProject.Path & "\" & aryFileList(lcv)
                    If Right(aryFileList(lcv), 3) = "pdf" Then
                        strFileName = FilePath & aryFileList(lcv)
                        FileCopy strFileName, PullFile
                    End If
                    .Attachments.Add PullFile
                Next lcv
            End If
        End If
                
        If SendEdit = True Then
            .Display
            Exit Function
        Else
            .Send
        End If
    End With
    
    Set oDeliver = CreateObject("Redemption.MAPIUtils")
    oDeliver.DeliverNow
    oDeliver.Cleanup
    
Exit_SafeMail:

    If bolOpen = False Then
        oMail.Quit
    End If
    
    Set oDeliver = Nothing
    Set oSafe = Nothing
    Set oItem = Nothing
    Set oFoldr = Nothing
    Set oSpace = Nothing
    Set oMail = Nothing
    
    Exit Function
    
ErrorHandler:
    Call HandleErrors(Err, strMyName, "SendSafeEmail")
End Function


Doris Manning
Database Administrator
Hargrove Inc.
www.hargroveinc.com


-----Original Message-----
From: accessd-bounces at databaseadvisors.com
[mailto:accessd-bounces at databaseadvisors.com] On Behalf Of Mark H
Sent: Wednesday, June 18, 2003 8:53 AM
To: accessd at databaseadvisors.com
Subject: [AccessD] Accessing qindows Send To 


Hello All

Using Access XP on Win XP (also 97 on 2000)

I have a listbox which lists files related to a particular record. I would
like to be able to access the users "SendTo" options, for example to send
the selected files as attachments in an email etc. I would like to avoid
creating my own send to options as it would be preferable to use whats
already set up in Windows.

Any ideas much appreciated :o) 

Cheers

Mark

_______________________________________________
AccessD mailing list
AccessD at databaseadvisors.com
http://databaseadvisors.com/mailman/listinfo/accessd
Website: http://www.databaseadvisors.com



More information about the AccessD mailing list