Need help in VBA for embedded object in excel

H

HeenAS

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
 
HeenAS said:
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
Click to expand...
Exactly what is happening. "not getting desired output" is very vague.
 
Back
Top