none
Insert an attachment in Excel sheet through vba RRS feed

  • Question

  • Hi,

    It is a continuation of my previous post. To avoid confusion I'm creating another Thread.

    I have one excel sheet(Test.xlsm) with a command button. I want to embed some word documents in the excel sheet(in Sheet1) once I press the command button. I have some word document in the "C:\Users\Deb\Desktop\Test(Folder)" which I want to embed in my excel sheet(Test.xlsx) and the name of the files are File1.docx,File2docx,Fil3.docx and so on.. In the excel sheet I have the File names of the word files in B row. I want once I press the command button All the document files will be embedded in the excel sheet.

    For example:

    If I have File1.docx in cell B1 then corresponding file will be embedded in E1 again

    If I have File2.docx in cell B7 then corresponding file will be embedded in E7 again

    If I have File3.docx in cell B10 then corresponding file will be embedded in E10.

    Basically all the file names of the word files will be present in the excel sheet(in row B). What All I need is to find the correct file names from the excel sheet and embed the corresponding files.

    For the above problem statement I'm using the following code:

    Private Sub CommandButton1_Click()
      Dim OO As OLEObject
      Dim R As Range
      Dim Path As String
    
      Dim ImportList As Range
      Dim Destination As Worksheet
      Dim App As Application
      Dim Wb As Workbook
      
      Set App = CreateObject("Excel.Application")
      Set Wb = App.Workbooks.Open("C:\Users\Deb\Desktop\Test1.xlsx")
      Set Destination = Wb.Sheets("Sheet1")
      With Destination
        Set ImportList = .Range("B1", .Range("B" & .Rows.Count).End(xlUp))
      End With
    
      Path = "C:\Users\Deb\Desktop\Test(Folder)\"
    
      'Visit each cell
      For Each R In ImportList
        If IsEmpty(R) Then GoTo Skip
        'File exists?
        If Dir(Path & R) <> "" Then
          'Embed
        Set OO = Destination.OLEObjects.Add( _
            Filename:=Path & R, Link:=False, DisplayAsIcon:=True, _
            IconFileName:=Application.Path & "\WINWORD.EXE", _
            IconIndex:=0, IconLabel:=R.Value, _
            Left:=R.Left, Top:=R.Offset(1, 0).Top)
        End If
    Skip:
      Next
      Wb.Close True
      App.Quit
    End Sub

    But It is only working if I have the file name with extension in B column of Test1.xlsm workbook. Suppose If I have File1(Only File Name)  instead of File1.docx the above code is unable to embed the actual file . Can anyone help me find the resolution of this problem.

    Thanks!!


    Saturday, May 16, 2015 8:07 AM

Answers

  • As per Suggestion of Mr Hans...

    Private Sub CommandButton1_Click()
      Dim OO As OLEObject
      Dim R As Range
      Dim Path As String
      Dim sFName As String
        
        
      Dim ImportList As Range
      Dim Destination As Worksheet
      Dim App As Application
      Dim Wb As Workbook
        
      Set App = Application
      Set Wb = App.Workbooks.Open("C:\Users\Deb\Desktop\Test1.xlsx")
      Set Destination = Wb.Sheets("Sheet1")
      With Destination
        Set ImportList = .Range("B1", .Range("B" & .Rows.Count).End(xlUp))
      End With
    
      Path = "C:\Users\Deb\Desktop\Test(Folder)\"
    
      'Visit each cell
      For Each R In ImportList
        If Not (IsEmpty(R)) Then
        'File exists?
        sFName = Path & R & ".docx"
        If Dir(sFName) <> "" Then
          'Embed
        Set OO = Destination.OLEObjects.Add( _
            Filename:=sFName, Link:=False, DisplayAsIcon:=True, _
            IconFileName:=Application.Path & "\WINWORD.EXE", _
            IconIndex:=0, IconLabel:=R.Value, _
            Left:=R.Left, Top:=R.Offset(1, 0).Top)
        End If
    End If
    
    Next R
    
    Wb.Close True
    
    End Sub
    
    


    Best Regards,
    Asadulla Javed, Kolkata
    ---------------------------------------------------------------------------------------------
    Please do not forget to click “Vote as Helpful” if any post helps you and "Mark as Answer”if it solves the issue.

    • Marked as answer by Deb_chatt Tuesday, May 19, 2015 3:14 PM
    Monday, May 18, 2015 10:14 AM
    Answerer

All replies

  • If the extension will always be .docx you can change

    Filename:=Path & R

    to

    Filename:=Path & R & ".docx"


    Regards, Hans Vogelaar (http://www.eileenslounge.com)

    Saturday, May 16, 2015 8:49 AM
  • Hi Hans,

    Thanks for your reply. I have tried what you have mentioned but documents are not embedding in Test1.xlsx file.




    • Edited by Deb_chatt Saturday, May 16, 2015 9:58 AM
    Saturday, May 16, 2015 9:50 AM
  • Check if it helps
    Private Sub CommandButton1_Click()
      Dim OO As OLEObject
      Dim R As Range
      Dim Path As String
    
      Dim ImportList As Range
      Dim Destination As Worksheet
      Dim App As Application
      Dim Wb As Workbook
      
      Set App = Application
      Set Wb = App.Workbooks.Open("C:\Users\Deb\Desktop\Test1.xlsx")
      Set Destination = Wb.Sheets("Sheet1")
      With Destination
        Set ImportList = .Range("B1", .Range("B" & .Rows.Count).End(xlUp))
      End With
    
    
    Path = "C:\Users\Deb\Desktop\Test(Folder)\"
    
      'Visit each cell
      For Each R In ImportList
        If Not (IsEmpty(R)) Then
        'File exists?
        If Dir(Path & R) <> "" Then
          'Embed
        Set OO = Destination.OLEObjects.Add( _
            Filename:=Path & R, Link:=False, DisplayAsIcon:=True, _
            IconFileName:=Application.Path & "\WINWORD.EXE", _
            IconIndex:=0, IconLabel:=R.Value, _
            Left:=R.Left, Top:=R.Offset(1, 0).Top)
        End If
    End If
    
    Next R
    
    Wb.Close True
    
    End Sub
    
    


    Best Regards,
    Asadulla Javed, Kolkata
    ---------------------------------------------------------------------------------------------
    Please do not forget to click “Vote as Helpful” if any post helps you and "Mark as Answer”if it solves the issue.

    Saturday, May 16, 2015 11:06 AM
    Answerer
  • Hi Asadulla,

    It's seems like you have posted the same code which I have already posted above. Anyway, it's not working.

    Please note that in Test1.xlsx file I have only file names(without extension) in B column.  

    Saturday, May 16, 2015 6:42 PM
  • Hmm,

    To a wise man everything is same.

    But in my reply I did some updates in code.

    a) It is not necessary to create separate instance of excel.

    b)The loop used not required to be so complex.

    But to help in your main issue pls confirm below...

    Test.xlsm contains the commandbutton and above macro.

    Test.xlsx contains the Filename only in B column.


    Best Regards,
    Asadulla Javed, Kolkata
    ---------------------------------------------------------------------------------------------
    Please do not forget to click “Vote as Helpful” if any post helps you and "Mark as Answer”if it solves the issue.

    Sunday, May 17, 2015 6:28 PM
    Answerer
  • It is only working if B columns of test1.xlsx file have the file name with extension (say File1.docx). If B column contains only File Name (File1) then the code is not able to embed the docx file in test1.xlsx file.

    Thanks!!

    Monday, May 18, 2015 9:35 AM
  • As per Suggestion of Mr Hans...

    Private Sub CommandButton1_Click()
      Dim OO As OLEObject
      Dim R As Range
      Dim Path As String
      Dim sFName As String
        
        
      Dim ImportList As Range
      Dim Destination As Worksheet
      Dim App As Application
      Dim Wb As Workbook
        
      Set App = Application
      Set Wb = App.Workbooks.Open("C:\Users\Deb\Desktop\Test1.xlsx")
      Set Destination = Wb.Sheets("Sheet1")
      With Destination
        Set ImportList = .Range("B1", .Range("B" & .Rows.Count).End(xlUp))
      End With
    
      Path = "C:\Users\Deb\Desktop\Test(Folder)\"
    
      'Visit each cell
      For Each R In ImportList
        If Not (IsEmpty(R)) Then
        'File exists?
        sFName = Path & R & ".docx"
        If Dir(sFName) <> "" Then
          'Embed
        Set OO = Destination.OLEObjects.Add( _
            Filename:=sFName, Link:=False, DisplayAsIcon:=True, _
            IconFileName:=Application.Path & "\WINWORD.EXE", _
            IconIndex:=0, IconLabel:=R.Value, _
            Left:=R.Left, Top:=R.Offset(1, 0).Top)
        End If
    End If
    
    Next R
    
    Wb.Close True
    
    End Sub
    
    


    Best Regards,
    Asadulla Javed, Kolkata
    ---------------------------------------------------------------------------------------------
    Please do not forget to click “Vote as Helpful” if any post helps you and "Mark as Answer”if it solves the issue.

    • Marked as answer by Deb_chatt Tuesday, May 19, 2015 3:14 PM
    Monday, May 18, 2015 10:14 AM
    Answerer