title: How to copy embeded object and paste in temp folder with VBA
body: <p>I have to create a code to save configuration script of routers from specified list. </p>
  
  <ol>
  <li><p>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.</p></li>
  <li><p>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:</p>
  
  <pre><code>EmbeddedObject.Copy
  Set oFolder = CreateObject("Shell.Application").Namespace(sFolder &amp; Chr(0))
  oFolder.Self.InvokeVerb "Paste"
  </code></pre></li>
  <li><p>Here the problem is after copy-paste, the file is showing as corrupted. I tried adding a zip file, but zip also gets corrupted.</p></li>
  <li><p>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.</p></li>
  </ol>
  
  <p>Please help me with to copy it in better way without getting file corrupted.</p>
  
  <p>Here is my code.</p>
  
  <pre><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 : '" &amp; .SAVED_FILE_PATH_NAME &amp; " '", 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)) &lt;&gt; 0 Then 'Err.Raise 58
          Dim FSO As Object
          Set FSO = CreateObject("scripting.filesystemobject")
  
          FSO.deletefile FilePathName &amp; "\*.*", 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 &amp; "\plink*"
          oShell.SendKeys "{F5}"         '\----it extracts to temp-----------\
          oShell.SendKeys FilePathName
          oShell.SendKeys "{ENTER}"
          Application.Wait (Now + TimeValue("0:00:01"))
          oShell.AppActivate sFolder &amp; "\plink*"
          oShell.SendKeys ("%{F4}")
  
  '----Copy the object without opening-----
  
  ' EmbeddedObject.Copy
  ' Set oFolder = CreateObject("Shell.Application").Namespace(sFolder &amp; 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 &amp; "\"
      sCurFile = Dir$(Folder &amp; "*.*", vbNormal)
      Do While Len(sCurFile) &gt; 0
          dCurDate = FileDateTime(Folder &amp; sCurFile)
          If dCurDate &gt; dNewestDate Then
              dNewestDate = dCurDate
              sNewestFile = Folder &amp; sCurFile
          End If
          sCurFile = Dir$()
      Loop
      GetPastedFile = sNewestFile
  End Function
  
  
  Private Sub CleanClipBoard()
      OpenClipboard 0
      EmptyClipboard
      CloseClipboard
  End Sub
  </code></pre>