Need help in VBA for embedded object in excel

Joined
Jul 23, 2019
Messages
1
Reaction score
0
Hi there,

I need help to write macro code to read & save the embedded text object to the path of activeworkbook. This is my code so far but still not getting desired output. any help is appreciated.

Dim FSO As Object
Dim oEmbFile As OLEObject
Dim Filename As String
Dim NewPath As String

Set oEmbFile = ThisWorkbook.Sheets("Sheet2").OLEObjects(1)
'oEmbFile.Visible = False
'NewPath = ActiveWorkbook.Path ' New directory name
'MkDir NewPath
'oEmbFile.Copy
If Dir(ActiveWorkbook.Path & "\BCG_update.txt") <> "" Then
oEmbFile.Copy
'oEmbFile.savetofile ActiveWorkbook.Path & "\BCG_update.txt"






CreateObject("Shell.Application").Namespace(ActiveWorkbook.Path & "\").Self.InvokeVerb "Paste"
'oEmbFile.Object.SaveAs Filename:=NewPath & "\" & "BCG_update" & ".txt", FileFormat:=xlTextWindows
If Dir(ActiveWorkbook.Path & "\BCG_update.txt") <> "" Then
Set FSO = CreateObject("scripting.filesystemobject")
If Dir("C:\BCGexpanderLib\") = "" Then
MkDir ("C:\BCGexpanderLib")
End If
If Dir("C:\BCGexpanderLib\Dll1.dll") <> "" Then
FSO.Deletefile "C:\BCGexpanderLib\Dll1.dll"
End If
FSO.moveFile ActiveWorkbook.Path & "\BCG_update.txt", "C:\BCGexpanderLib\Dll1.dll"
Else

'oEmbFile.Object.SaveAs2 Filename:=NewPath & "\" & "BCG_update" & ".txt", FileFormat:=xlTextWindows
Application.DisplayAlerts = True


End If
If Dir("C:\BCGexpanderLib\") = "" Then ' need to update this to check for valid updates to dll
MsgBox "BCG_update.txt not found"
End
End If
 
Joined
Dec 13, 2017
Messages
71
Reaction score
19
Hi there,

I need help to write macro code to read & save the embedded text object to the path of activeworkbook. This is my code so far but still not getting desired output. any help is appreciated.

Dim FSO As Object
Dim oEmbFile As OLEObject
Dim Filename As String
Dim NewPath As String

Set oEmbFile = ThisWorkbook.Sheets("Sheet2").OLEObjects(1)
'oEmbFile.Visible = False
'NewPath = ActiveWorkbook.Path ' New directory name
'MkDir NewPath
'oEmbFile.Copy
If Dir(ActiveWorkbook.Path & "\BCG_update.txt") <> "" Then
oEmbFile.Copy
'oEmbFile.savetofile ActiveWorkbook.Path & "\BCG_update.txt"






CreateObject("Shell.Application").Namespace(ActiveWorkbook.Path & "\").Self.InvokeVerb "Paste"
'oEmbFile.Object.SaveAs Filename:=NewPath & "\" & "BCG_update" & ".txt", FileFormat:=xlTextWindows
If Dir(ActiveWorkbook.Path & "\BCG_update.txt") <> "" Then
Set FSO = CreateObject("scripting.filesystemobject")
If Dir("C:\BCGexpanderLib\") = "" Then
MkDir ("C:\BCGexpanderLib")
End If
If Dir("C:\BCGexpanderLib\Dll1.dll") <> "" Then
FSO.Deletefile "C:\BCGexpanderLib\Dll1.dll"
End If
FSO.moveFile ActiveWorkbook.Path & "\BCG_update.txt", "C:\BCGexpanderLib\Dll1.dll"
Else

'oEmbFile.Object.SaveAs2 Filename:=NewPath & "\" & "BCG_update" & ".txt", FileFormat:=xlTextWindows
Application.DisplayAlerts = True


End If
If Dir("C:\BCGexpanderLib\") = "" Then ' need to update this to check for valid updates to dll
MsgBox "BCG_update.txt not found"
End
End If
Exactly what is happening. "not getting desired output" is very vague.
 

Ask a Question

Want to reply to this thread or ask your own question?

You'll need to choose a username for the site, which only take a couple of moments. After that, you can post your question and our members will help you out.

Ask a Question

Top