Attaching Workbooks to Outlook Message

[Jas]

Hello,

I have code in my workbook (partial listing below) to attach to outlook message which works fine.

.
.
With OutlookMail
    .Display
    .To = "email address"
    .CC = ""
    .BCC = ""
    .Subject = wSubject
    .Attachments.Add Application.ActiveWorkbook.FullName
EndWith
.
.

However, the above code does not work if the workbook is opened as an embedded object in a word document.

Please make suggestion/guidance to resolve this issue.

 

[rrocker1405]

Hello,

I have code in my workbook (partial listing below) to attach to outlook message which works fine.

.
.
With OutlookMail
    .Display
    .To = "email address"
    .CC = ""
    .BCC = ""
    .Subject = wSubject
    .Attachments.Add Application.ActiveWorkbook.FullName
EndWith
.
.
[\CODE]

However, the above code does not work if the workbook is opened as an embedded object in a word document.

Please make suggestion/guidance to resolve this issue.

Hi Jas,

I would use something like this. Update email address and details accordingly

Sub Mail_Single_SendRequest()

'Working in 2000-2010
    Dim wb1 As Workbook
    Dim wb2 As Workbook
    Dim TempFilePath As String
    Dim TempFileName As String
    Dim FileExtStr As String
    Dim OutApp As Object
    Dim OutMail As Object
    Dim r As Integer, x As Double
   
    For r = 2 To 2 'data in row 2 for inserting name as part of signature
    Dim strbody As String
    With Application
   
    .ScreenUpdating = False
    .EnableEvents = False
    End With

    Set wb1 = ActiveWorkbook

    If Val(Application.Version) >= 12 Then
        If wb1.FileFormat = 51 And wb1.HasVBProject = True Then
            MsgBox "There is VBA code in this xlsx file, there will" & vbNewLine & _
                  "be no VBA code in the file you send. Save the" & vbNewLine & _
                  "file first as xlsm and then try the macro again.", vbInformation
            Exit Sub
        End If
    End If

    With Application
        .ScreenUpdating = False
        .EnableEvents = False
    End With

    'Make a copy of the file/Open it/Mail it/Delete it
    'If you want to change the file name then change only TempFileName
    TempFilePath = Environ$("temp") & "\"
    TempFileName = wb1.Name & " " & Format(Now, "dd-mmm-yy h-mm-ss")
    FileExtStr = "." & LCase(Right(wb1.Name, _
                                  Len(wb1.Name) - InStrRev(wb1.Name, ".", , 1)))

    wb1.SaveCopyAs TempFilePath & TempFileName & FileExtStr
    Set wb2 = Workbooks.Open(TempFilePath & TempFileName & FileExtStr)

    Set OutApp = CreateObject("Outlook.Application")
    Set OutMail = OutApp.CreateItem(0)

    On Error Resume Next
   
    strbody = "Hi " & "[Recipient Name]," _
    & Chr(10) & Chr(10) & "[Subject]." _
    & Chr(10) & Chr(10) & "Best Regards," _
    & Chr(10) & Chr(10) & Cells(r, 6)
         
   
      ' Change the mail address and subject in the macro before
      ' running the procedure.
      'get the email address
   
    OutMail = Cells(r, 5)
     
    With OutMail
    .To = "abc.xyz@Domain.com"
    .CC = "def.GHI@Domain.com"
    .BCC = ""
    .Subject = "[Subject of the email]"
    .Body = strbody & .Body
    .Attachments.Add wb2.FullName
    'You can add other files also like this
    '.Attachments.Add ("C:\test.txt")
    .display  'or use .Display
    End With
    On Error GoTo 0

    wb2.Close SaveChanges:=False

    'Delete the file
    Kill TempFilePath & TempFileName & FileExtStr

    Set OutMail = Nothing
    Set OutApp = Nothing

    With Application
    .ScreenUpdating = True
    .EnableEvents = True
    End With
    Next r
    End Sub

Kind regards,
A!

 

[Jas]

Wow...thank you...I will try that.