How to copy embeded object and paste in temp folder with VBA - vba

Question

I have to create a code to save configuration script of routers from specified list.
Using telnet and VBA I'm able to fulfill my requirement. But telnet window is visible every time and also I have to rely on SendKeys to send Commands properly to that telnet window.
I have embedded 'plink.exe' as an "Object 7" in Sheet1. below is the code which copies this object and paste created of today's date in temp folder:
EmbeddedObject.Copy
Set oFolder = CreateObject("Shell.Application").Namespace(sFolder & Chr(0))
oFolder.Self.InvokeVerb "Paste"
Here the problem is after copy-paste, the file is showing as corrupted. I tried adding a zip file, but zip also gets corrupted.
So I had added a code to open the object within Excel and using SendKeys and 7z Extractor I extract to temp folder again relying on SendKeys.
Please help me with to copy it in better way without getting file corrupted.
Here is my code.
Option Explicit
#If VBA7 Then
Private Declare PtrSafe Function EmptyClipboard Lib "user32" () As Long
Private Declare PtrSafe Function OpenClipboard Lib "user32" (ByVal hWnd As LongPtr) As LongPtr
Private Declare PtrSafe Function CloseClipboard Lib "user32" () As Long
#Else
Private Declare Function EmptyClipboard Lib "user32" () As Long
Private Declare Function OpenClipboard Lib "user32" (ByVal hWnd As Long) As Long
Private Declare Function CloseClipboard Lib "user32" () As Long
#End If
Private Type FUNC_OUT_RESULTS
SUCCESS As Boolean
SAVED_FILE_PATH_NAME As String
ERROR As String
End Type
Sub test()
Dim tRes As FUNC_OUT_RESULTS
Dim oleObj As OLEObject
tRes = SaveEmbeddedOleObjectToDisk _
(EmbeddedObject:=ActiveSheet.OLEObjects("Object 7"), FilePathName:="C:\Users\user\AppData\Local\Temp\20170512\")
With tRes
If .SUCCESS Then
MsgBox "OleObject successfully saved as : '" & .SAVED_FILE_PATH_NAME & " '", vbInformation
Else
MsgBox .ERROR, vbCritical
End If
End With
End Sub
Private Function SaveEmbeddedOleObjectToDisk( _
ByVal EmbeddedObject As OLEObject, _
ByVal FilePathName As String _
) _
As FUNC_OUT_RESULTS
Dim oFolder As Object
Dim sFolder As String
On Error GoTo errHandler
If Len(Dir$(FilePathName)) <> 0 Then 'Err.Raise 58
Dim FSO As Object
Set FSO = CreateObject("scripting.filesystemobject")
FSO.deletefile FilePathName & "\*.*", True 'Delete files
FSO.deletefolder FilePathName 'Delete Todays Date folder
MkDir FilePathName 'Make Todays Date folder
End If
'\---------------------------------------\
sFolder = Left$(FilePathName, InStrRev(FilePathName, "\") - 10)
If Len(Dir$(sFolder, vbDirectory)) = 0 Then
MkDir sFolder
End If
If EmbeddedObject.OLEType = xlOLEEmbed Then
EmbeddedObject.Verb Verb:=xlPrimary '\---Here it opens within excel
Set EmbeddedObject = Nothing
Application.DisplayAlerts = True
Dim oShell
Set oShell = CreateObject("WScript.Shell")
Application.Wait (Now + TimeValue("0:00:02"))
oShell.AppActivate sFolder & "\plink*"
oShell.SendKeys "{F5}" '\----it extracts to temp-----------\
oShell.SendKeys FilePathName
oShell.SendKeys "{ENTER}"
Application.Wait (Now + TimeValue("0:00:01"))
oShell.AppActivate sFolder & "\plink*"
oShell.SendKeys ("%{F4}")
'----Copy the object without opening-----
' EmbeddedObject.Copy
' Set oFolder = CreateObject("Shell.Application").Namespace(sFolder & Chr(0))
' oFolder.Self.InvokeVerb "Paste"
'\---------------------------------------\
SaveEmbeddedOleObjectToDisk.SAVED_FILE_PATH_NAME = FilePathName
SaveEmbeddedOleObjectToDisk.SUCCESS = True
End If
Call CleanClipBoard
Exit Function
errHandler:
SaveEmbeddedOleObjectToDisk.ERROR = Err.Description
Call CleanClipBoard
End Function
Private Function GetPastedFile( _
ByVal Folder As String _
) _
As String
Dim sCurFile As String
Dim sNewestFile As String
Dim dCurDate As Date
Dim dNewestDate As Date
Folder = Folder & "\"
sCurFile = Dir$(Folder & "*.*", vbNormal)
Do While Len(sCurFile) > 0
dCurDate = FileDateTime(Folder & sCurFile)
If dCurDate > dNewestDate Then
dNewestDate = dCurDate
sNewestFile = Folder & sCurFile
End If
sCurFile = Dir$()
Loop
GetPastedFile = sNewestFile
End Function
Private Sub CleanClipBoard()
OpenClipboard 0
EmptyClipboard
CloseClipboard
End Sub