How can I attach an object (file that was attached to an worksheet ) to an email?

[bleeet]

Hi guys

I am trying to make an outlook email button that when pressed it will attach an already attached file (object) that's on a cell in the worksheet into the body of the email.

Hope this makes sense to you guys


thanks

 

[Kenneth Hobson]

It depends I guess.

1. If linked, it would not make sense without manual extras like adding the path to the file in Alternative Text.
2. If embedded, a WordEditor method can copy and paste it.
3. If either above and file type is like Excel, Word, or such, it can be saved as a file and attached.
4. A typical method is to find the OleObject's TopLeftCell to identify which one that is needed. Naming the Object is the better way to make use of it later like in this task.
e.g. not "Object 1" on Sheet1 but "wordAccounts" on Sheet1.

See what you think about these items and respond accordingly. We can then move on to a solution.

 

[bleeet]

It depends I guess.

1. If linked, it would not make sense without manual extras like adding the path to the file in Alternative Text.
2. If embedded, a WordEditor method can copy and paste it.
3. If either above and file type is like Excel, Word, or such, it can be saved as a file and attached.
4. A typical method is to find the OleObject's TopLeftCell to identify which one that is needed. Naming the Object is the better way to make use of it later like in this task.
e.g. not "Object 1" on Sheet1 but "wordAccounts" on Sheet1.

See what you think about these items and respond accordingly. We can then move on to a solution.

thanks for the reply

the file type can be a variety of files such as word, ppt, excel and screen shot.

the code I have to attach the document to the excel sheet is here how can I name the object so that I can attach the file to the email?

'Select the cell in which you want to place the attachment    Range("C39").Select
       
    'Get file path
    fpath = Application.GetOpenFilename("All Files,*.*", Title:="Select file")
    If LCase(fpath) = "false" Then Exit Sub
        
    'Insert file
    ActiveSheet.OLEObjects.Add _
    Filename:=fpath, _
    Link:=False, _
    DisplayAsIcon:=True, _
    IconFileName:="excel.exe", _
    IconIndex:=0, _
    IconLabel:=extractFileName(fpath)

 

[Kenneth Hobson]

This needs some work but should get you close. Be sure to add the two references by Tools > References menus in the VBE as commented.

Change the body parts to suit. e.g. Remove the Range copy/paste part. When pasting like that, there can be some overlap.

Note the changes to your ole Add routine. Change the prefix name to suit. At least you will then be able to get the oleObject/Shape by prefix name or the shape's TopLeftCell now. I also added the AlternativeText with the filename so you can easily find the file for attachment or such.

Sub AddOLE()
  Dim fPath, i As Integer, oleName$
  i = ActiveSheet.OLEObjects.Count + 1
  oleName = "oleFile" & i 'Make sure we make a unique name.
  
  'Select the cell in which you want to place the attachment
  Range("C39").Select
       
  'Get file path
  fPath = Application.GetOpenFilename("All Files,*.*", Title:="Select file")
  If fPath = False Then Exit Sub
      
  'Insert file
  With ActiveSheet
    .OLEObjects.Add _
      Filename:=fPath, _
      Link:=False, _
      DisplayAsIcon:=True, _
      IconFileName:="excel.exe", _
      IconIndex:=0, _
      IconLabel:=CreateObject("Scripting.FileSystemObject").GetBaseName(fPath)
    .OLEObjects(i).Name = oleName
    With .Shapes(oleName)
      .AlternativeText = fPath
      .Top = [C39].Top
      .Left = [C39].Left
    End With
  End With
End Sub

Sub Main()
  Dim S$, T$, sig$
  'Tools > References > Microsoft Outlook xx.0 Object Library > OK
  Dim olApp As Outlook.Application, olMail As Outlook.MailItem
  'Tools > References > Microsoft Word xx.0 Object Library > OK
  Dim Word As Document, wr As Word.Range, rTo As Recipient, wos As Word.Selection
  
  'INPUTS to change if needed...........................................................
  S = "Hello World Example" 'Subject
  T = "ken@gmail.com"       'To
  sig = ThisWorkbook.Path & "\sig.rtf" 'contents to copy for signature.
  'End INPUTS...........................................................................
   
  'Get Outlook application
  Set olApp = New Outlook.Application
      
  'Make email, send/display.
  'Set olMail = olApp.CreateItem(olMailItem)
  With olApp.CreateItem(olMailItem)
    .Subject = S
    .Importance = olImportanceNormal
    
    'Set the recipient(s) for To field and resolve.
    Set rTo = .Recipients.Add(T)
    rTo.Resolve
    rTo.Type = olTo 'olTo, olcc, olbcc
    If rTo.Resolved = False Then
      Debug.Print T & "email address: Resolved=False"
      '.To = T  'Using rTo above for .To instead.
      GoTo TheEnd
    End If
    
    'Setup WordEditor parts:
    .GetInspector.Display
    Set Word = .GetInspector.WordEditor
    Set wr = Word.Range
       
    'Body, introductory text:
    Word.Content = "Dear VBA Enthusiast, " & vbCrLf & vbCrLf & _
          "I hope that you find this example of copied Excel Range " _
          & "and embedded OLEObject using WordEditor in Outlook " _
          & "useful." & String(4, vbCrLf)
          

    'Body, range A1, copy/paste:
    'Set wos = Word.Windows(1).Selection
    Sheet1.Range("A1").CopyPicture xlScreen, xlBitmap
    wr.Collapse Direction:=wdCollapseEnd
    'Word.Range(Start:=Word.Content.End - 2).PasteAndFormat wdPasteDefault
    wr.Paste
    
    wr.Collapse Direction:=wdCollapseEnd
    Word.Range.InsertAfter String(4, vbCrLf)
    
    'Body, copy/paste OLEObject
    Sheet1.OLEObjects("pdfFirstName").Copy
    wr.Collapse Direction:=wdCollapseEnd
    Word.Range(Start:=Word.Content.End - 2).PasteAndFormat wdPasteDefault
    'wr.Paste
    
    'Body, copy/paste contents of sig.rtf, signature...
    GetObject(sig).Range.Copy
    wr.Collapse Direction:=wdCollapseEnd
    'Word.Range(Start:=Word.Content.End - 2).PasteAndFormat wdPasteDefault
    wr.Paste
    
    '.Attachments.Add e 'e is the full path to a file.
    .Display
    '.Send
  End With
  
TheEnd:
  Set olMail = Nothing
  Set olApp = Nothing
End Sub

 

[bleeet]

thanks for replying Kenneth Hobson

which references are you referring to that has to be added?

 

[Kenneth Hobson]

When working with Outlook and Word objects in Excel, those are the 2 object references to add if want to take advantage of intellisense. I showed how in the comment for Main(), the 2nd Sub.