Home » excel » excel – Embed OLEobject based on cell

excel – Embed OLEobject based on cell

Posted by: admin April 23, 2020 Leave a comment


I want to embed an OLEObject (text file) in Excel, with the filename being derived from a particular cell. I can do this as a one off action but am now trying to make it work in a loop through all the cells in a column, finishing when it comes across an empty cell.

I can’t seem to get the right syntax to make the If/Else loop work:

Sub Insert_Text_File()

Dim ol As OLEObject
Dim path As String
Dim file As String
Dim filenameinvisible As String
Dim rangeA As Range
Dim rangeD As Range

path = ActiveWorkbook.Path
file = Range(i,1).Value & "-Live" & ".txt"
Set rangeA = Range("A" & i)
Set rangeD = Range("D" & i)

For i = 2 To 200
    If Range("A" & i) <> "" Then
        Set ol = Worksheets("Inventory").OLEObjects.Add (Filename:= path & "\" & file, Link:=False, DisplayAsIcon:=True, Height:=10)

        ol.Top =Range("D" & i).top

        ol.left=Range("D" & i).left

    End If
    Next i
End Sub
How to&Answers:

I think the problem with your current approach is that your are assigning the value to the path variable only once – file = Range(i,1).Value & "-Live" & ".txt" before the loop increases i.

A better approach requiring less variables would be using a for each loop using a cell variable of Range type and relying on VBA to find the last row used rather than hard-coding 200 into the loop.

Try this approach and let us know if that has worked.

Sub Insert_Text_File()
Application.ScreenUpdating = False

    Dim cell As Range

    ' loop each cell in column A 
    For Each cell In Range("A2:A" & Range("A" & Rows.Count).End(xlUp).Row)
         ' make sure the cell is NOT empty before doing any work
         If Not IsEmpty(cell) Then

            ' create and insert a new OleObject based on the path
            Dim ol As OLEObject
            ' ActiveWorkbook.path & "\" & cell & "-Live.txt" will make the filename
            Set ol = ActiveSheet.OLEObjects.Add( _
                                                Filename:=ActiveWorkbook.path & "\" & cell & "-Live.txt", _
                                                Link:=False, _
                                                DisplayAsIcon:=True, _
            ' align the OleObject with Column D - (0 rows, 3 columns to the right from column A)
            With ol
                .Top = cell.Offset(0, 3).Top
                .Left = cell.Offset(0, 3).Left
            End With
        End If
Application.ScreenUpdating = True
End Sub