在Excel窗口中打开附件并复制到打开工作簿

使用Outlook VBA - 我想在excel的特定实例中打开附件，然后将该附件中的工作表复制到打开的工作簿中 .

我使用了几个代码片段（Saving Outlook attachment with date in the filename和Check to see if Excel is open (from another Office 2010 App)来保存电子邮件中的附件，然后找到我需要打开它的excel窗口 - 两者都在独立的outlook测试宏中工作 .

麻烦的是，我似乎无法将这两个部分连接成一个工作代码，在我所有的结尾处：

Option Explicit
Private Declare Function newFindWindowEx Lib "user32" Alias "FindWindowExA" _
 (ByVal hWnd1 As Long, ByVal hWnd2 As Long, ByVal lpsz1 As String, _
 ByVal lpsz2 As String) As Long

 Private Declare Function GetDesktopWindow Lib "user32" () As Long

 Private Declare Function AccessibleObjectFromWindow& Lib "oleacc" _
  (ByVal hwnd&, ByVal dwId&, riid As newGUID, xlWB As Object)

Private Const newOBJID_NATIVEOM = &HFFFFFFF0

Private Type newGUID
    lData1 As Long
    iData2 As Integer
    iData3 As Integer
    aBData4(0 To 7) As Byte
End Type


Sub AttachmentToExcel()

  Dim obj As Object
  Dim msg As Outlook.MailItem

  Dim objAtt As Object, iDispatch As newGUID
  Dim sPath As String, sFileName As String, sFile As String, filewithoutExt As String
  Dim attachFileName As String, DealID As String
  Dim srcWorkbook As Object

  sPath = "\\eu.insight.com\users\mklefass\Data\Desktop\"
  sFileName = "Test Workbook.xlsx": filewithoutExt = "Test Workbook.xlsx"
  sFile = sPath & sFileName


  Set obj = GetCurrentItem
  If TypeName(obj) = "MailItem" Then
      Set msg = obj
      DealID = FindDealID(msg.Subject)

      For Each objAtt In msg.Attachments
        If Right(objAtt.FileName, 4) = ".txt" Then
            attachFileName = "C:\Users\mklefass\Desktop\tmp\" & objAtt.FileName & ".tsv"
            objAtt.SaveAsFile attachFileName
            Set objAtt = Nothing
        End If
      Next

    ' Find window that has our main workbook open

      Dim dsktpHwnd As Long, hwnd As Long, mWnd As Long, cWnd As Long, wb As Object

      newSetIDispatch iDispatch

      dsktpHwnd = GetDesktopWindow

      hwnd = newFindWindowEx(dsktpHwnd, 0&, "XLMAIN", vbNullString)

      mWnd = newFindWindowEx(hwnd, 0&, "XLDESK", vbNullString)

      While mWnd <> 0 And cWnd = 0
        cWnd = newFindWindowEx(mWnd, 0&, "EXCEL7", filewithoutExt)
        hwnd = newFindWindowEx(dsktpHwnd, hwnd, "XLMAIN", vbNullString)
        mWnd = newFindWindowEx(hwnd, 0&, "XLDESK", vbNullString)
      Wend

    '~~> We got the handle of the Excel instance which has the file
      If cWnd > 0 Then
        '~~> Bind with the Instance
        Debug.Print AccessibleObjectFromWindow(cWnd, newOBJID_NATIVEOM, iDispatch, wb)
        '~~> Work with the file

        Set srcWorkbook = wb.accParent.Application.Workbooks.Open(attachFileName)
        'srcWorkbook.Worksheets(sheetNr).Copy after:=ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count)

        srcWorkbook.Close
        Set srcWorkbook = Nothing
      End If
   End If

End Sub
Private Sub newSetIDispatch(ByRef ID As newGUID)
 With ID
    .lData1 = &H20400
    .iData2 = &H0
    .iData3 = &H0
    .aBData4(0) = &HC0
    .aBData4(1) = &H0
    .aBData4(2) = &H0
    .aBData4(3) = &H0
    .aBData4(4) = &H0
    .aBData4(5) = &H0
    .aBData4(6) = &H0
    .aBData4(7) = &H46
 End With
End Sub

SetIDispatch，Findwindowex，accessibleobjectfromwindow都在Check to see if Excel is open (from another Office 2010 App)中定义，并且在我的代码中是相同的 .

最后一行失败，运行时错误438：对象不支持此属性或方法 . 这告诉我，我可能正在咆哮错误的树 - 我害怕虽然我不知道要瞄准哪棵树！

提前致谢 .