Results 1 to 1 of 1

Thread: CDO attachments

  1. #1
    Join Date
    Apr 2008
    Posts
    1

    Question Unanswered: CDO attachments

    Hi All,

    Fairly new in the world of Visual Basic and now confronted to a problem involving CDO attachments.

    I have an Excel File with macros refreshing data which I need to copy and paste into a workbook before emailing it, but the code I have will send the email without the attachment.

    I've searched for an answer and now believe that it will only work if in the code below I hard-type the path of the file.

    Is there no way around it, i.e. using a temporary file path and name, which I will "kill" later?

    Here is the coding, thanks for any help
    Code:
    Sub testEmail()
    
        Dim FileExtStr As String
        Dim FileFormatNum As Long
        Dim Sourcewb As Workbook
        Dim Destwb As Workbook
        Dim TempFilePath As String
        Dim TempFileName As String
        Dim EmailTo As String
        
        EmailTo = Sheets("Sheet1").Range("A1")
        
        With Application
            .ScreenUpdating = False
            .EnableEvents = False
        End With
     
        Set Sourcewb = ActiveWorkbook
              
        ActiveSheet.Copy
        Set Destwb = ActiveWorkbook
     
        With Destwb
            If Val(Application.Version) < 12 Then
                FileExtStr = ".xls": FileFormatNum = -4143
            Else
                If Sourcewb.Name = .Name Then
                    With Application
                        .ScreenUpdating = True
                        .EnableEvents = True
                    End With
                    MsgBox "Your answer is NO in the security dialog"
                    Exit Sub
                Else
                    Select Case Sourcewb.FileFormat
                    Case 51: FileExtStr = ".xlsx": FileFormatNum = 51
                    Case 52:
                        If .HasVBProject Then
                            FileExtStr = ".xlsm": FileFormatNum = 52
                        Else
                            FileExtStr = ".xlsx": FileFormatNum = 51
                        End If
                    Case 56: FileExtStr = ".xls": FileFormatNum = 56
                    Case Else: FileExtStr = ".xlsb": FileFormatNum = 50
                    End Select
                End If
            End If
        End With
    
        'Save the new workbook/Mail it/Delete it
        TempFilePath = Environ$("temp") & "\"
        TempFileName = "Part of " & Sourcewb.Name & " " & Format(Now, "dd-mmm-yy h-mm-ss")
     
      
        
        With Destwb
            .SaveAs TempFilePath & TempFileName & FileExtStr, FileFormat:=FileFormatNum
            On Error Resume Next
            .Close SaveChanges:=False
        End With
    
    
        
        Const cdoSendUsingPickup = 1 'Send message using the local SMTP service pickup directory.
        Const cdoSendUsingPort = 2 'Send the message using the network (SMTP over the network).
        
        Const cdoAnonymous = 0 'Do not authenticate
        Const cdoBasic = 1 'basic (clear-text) authentication
        Const cdoNTLM = 2 'NTLM
        
        Set objMessage = CreateObject("CDO.Message")
        objMessage.Subject = "xxxxx"
        objMessage.From = """Arnaud"" <xxxx.xxxx@xxxx.xxx>"
        objMessage.To = "xxxx.xxxx@xxxx.xxx"
        objMessage.CC = ""
        objMessage.BCC = ""
        objMessage.TextBody = "xxxx" & vbCrLf & vbCrLf & "test."
        objMessage.AddAttachment = Destwb.FullName
    
        objMessage.Configuration.Fields.Item _
        ("http://schemas.microsoft.com/cdo/configuration/sendusing") = 2
        
        objMessage.Configuration.Fields.Item _
        ("http://schemas.microsoft.com/cdo/configuration/smtpserver") = "xxx.xxx.xxx"
        
        objMessage.Configuration.Fields.Item _
        ("http://schemas.microsoft.com/cdo/configuration/smtpauthenticate") = cdoBasic
        
        objMessage.Configuration.Fields.Item _
        ("http://schemas.microsoft.com/cdo/configuration/sendusername") = "xxxx.xxxx@xxxx.xxx"
        
        objMessage.Configuration.Fields.Item _
        ("http://schemas.microsoft.com/cdo/configuration/sendpassword") = "xxx"
        
        objMessage.Configuration.Fields.Item _
        ("http://schemas.microsoft.com/cdo/configuration/smtpserverport") = 25
        
        objMessage.Configuration.Fields.Item _
        ("http://schemas.microsoft.com/cdo/configuration/smtpusessl") = False
    
        objMessage.Configuration.Fields.Item _("http://schemas.microsoft.com/cdo/configuration/smtpconnectiontimeout") = 60
        
        objMessage.Configuration.Fields.Update   
        objMessage.Send
            
            
    
    
        Kill TempFilePath & TempFileName & FileExtStr
        
        
        Set objMessage = Nothing
     
        With Application
            .ScreenUpdating = True
            .EnableEvents = True
        End With
    
    End Sub
    Last edited by loquin; 04-14-08 at 18:36. Reason: add [code] [/code] tags for readability.

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •