[AccessD] Email attachment problem

Marcus, Scott (GEAE, RHI Consulting) scott.marcus at ae.ge.com
Wed Apr 2 11:51:33 CST 2003


Try this, it waits for a shelled process to finish before moving on... (watch
for line wrap)
 
Private Declare Function CreateProcessA Lib "kernel32" (ByVal lpApplicationName
As String, ByVal lpCommandLine As String, ByVal lpProcessAttributes As Long,
ByVal lpThreadAttributes As Long, ByVal bInheritHandles As Long, ByVal
dwCreationFlags As Long, ByVal lpEnvironment As Long, ByVal lpCurrentDirectory
As Long, lpStartupInfo As STARTUPINFO, lpProcessInformation As
PROCESS_INFORMATION) As Long
 
Private Declare Function WaitForSingleObject Lib "kernel32" (ByVal hHandle As
Long, ByVal dwMilliseconds As Long) As Long
 
Private Declare Function CloseHandle Lib "kernel32" (ByVal hObject As Long) As
Long

Private Const NORMAL_PRIORITY_CLASS = &H20&

Private Type STARTUPINFO
    cb As Long
    lpReserved As String
    lpDesktop As String
    lpTitle As String
    dwX As Long
    dwY As Long
    dwXSize As Long
    dwYSize As Long
    dwXCountChars As Long
    dwYCountChars As Long
    dwFillAttribute As Long
    dwFlags As Long
    wShowWindow As Integer
    cbReserved2 As Integer
    lpReserved2 As Long
    hStdInput As Long
    hStdOutput As Long
    hStdError As Long
End Type
 
Private Type PROCESS_INFORMATION
    hProcess As Long
    hThread As Long
    dwProcessID As Long
    dwThreadID As Long
End Type
 
Private Sub ShellAndWait(sCmdLine As String)
    Dim lR As Long      'Return
    Dim uProc As PROCESS_INFORMATION
    Dim uStart As STARTUPINFO
    
  ' Initialize the STARTUPINFO structure:
    uStart.cb = Len(uStart)
    
  ' Start the shelled application:
    lR = CreateProcessA(sCmdLine, vbNullString, 0&, 0&, 1&,
NORMAL_PRIORITY_CLASS, 0&, 0&, uStart, uProc)
    
  ' Wait for the shelled application to finish:
    lR = WaitForSingleObject(uProc.hProcess, INFINITE)
    lR = CloseHandle(uProc.hProcess)
End Sub

 
Hope this helps. If anything is missing, let me know. I cut and pasted this from
a project.
 
Scott

-----Original Message-----
From: Mike and Doris Manning [mailto:mikedorism at ntelos.net]
Sent: Wednesday, April 02, 2003 12:45 PM
To: accessd at databaseadvisors.com
Subject: RE: [AccessD] Email attachment problem


Sure... I've been trying DoEvents but that hasn't worked.  I've checked the file
size after the ".Attachments.Add" line and it shows 64B when the file size is
really 23KB.

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 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
    Dim strSMTP As String
    
    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
                    strFileName = FilePath & aryFileList(lcv)
                    .Attachments.Add strFileName
                    DoEvents
                Next lcv
            End If
        End If
        DoEvents
        
        If SendEdit = True Then
            DoEvents
            .Save
            DoEvents
            .Display
            Exit Function
        Else
            .Send
        End If
    End With
    
    Set oDeliver = CreateObject("Redemption.MAPIUtils")
    oDeliver.DeliverNow
    oDeliver.Cleanup
    
    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
 
 

-----Original Message-----
From: accessd-bounces at databaseadvisors.com
[mailto:accessd-bounces at databaseadvisors.com] On Behalf Of John Ruff
Sent: Wednesday, April 02, 2003 12:35 PM
To: accessd at databaseadvisors.com
Subject: RE: [AccessD] Email attachment problem


Can we see your email code?
 
 

John V. Ruff - The Eternal Optimist :-) 
Always Looking For Contract Opportunities 

"Commit to the Lord whatever you do, 
        and your plans will succeed." Proverbs 16:3 

-----Original Message-----
From: accessd-bounces at databaseadvisors.com
[mailto:accessd-bounces at databaseadvisors.com] On Behalf Of Mike and Doris
Manning
Sent: Wednesday, April 02, 2003 9:25 AM
To: accessd at databaseadvisors.com
Subject: [AccessD] Email attachment problem


We have been working on building our own internal PDF Document Solution using
PDF995.  We can get the PDF files to create perfectly exactly where we want them
to.  The problem we now have is with our email code we built using Redemption.
 
The PDF original is 23KB but only 64B of that is making it to the email as an
attachment.
 
Does anybody have any thoughts on how we could slow the code down so that the
entire attachment would be added?  I'm trying to avoid using a message box, if
at all possible.
 
Doris Manning
Database Administrator
Hargrove Inc.
www.hargroveinc.com

-------------- next part --------------
An HTML attachment was scrubbed...
URL: <http://databaseadvisors.com/pipermail/accessd/attachments/20030402/139f1cc7/attachment-0001.html>


More information about the AccessD mailing list