在Excel窗口中打开附件并复制以打开工作簿
使用outlook VBA – 我想在excel的特定实例中打开附件，然后将附件中的表格复制到打开的工作簿中。
我已经使用了几个代码片段（ 在文件名中保存Outlook附件和date，并检查Excel是否打开（从另一个Office 2010应用程序）保存电子邮件附件，然后find我需要的Excel窗口打开它 – 都在孤立的前景testingmacros工作。
麻烦的是，我似乎无法将这两个部分连接在一起成为工作代码，在我所拥有的所有部分的最后：
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中查看是否打开Excel（从另一个Office 2010应用程序）并且在我的代码中是相同的。
最后一行失败，运行时错误438：对象不支持此属性或方法。 这暗示着我可能会在错误的树上咆哮 – 虽然我不知道哪棵树瞄准了！
提前致谢。
两个问题： AccessibleObjectFromWindow返回一个Window对象， Open方法是Application.Workbooks的成员; 并且窗口标题没有文件扩展名。
所以要解决第一个问题：
Set srcWorkbook = wb.Application.Open(attachFileName)
需要成为：
Set srcWorkbook = wb.Parent.Application.Workbooks.Open(attachFileName)
而对于Excel的某些安装中的第二个：
cWnd = FindWindowEx(mWnd, 0&, "EXCEL7", "Test Workbook.xlsx")
可能需要成为：
cWnd = FindWindowEx(mWnd, 0&, "EXCEL7", "Test Workbook")
注意将来的读者：这似乎取决于Windows和Excel版本，以及是否启用“隐藏已知的文件扩展名”在Windows资源pipe理器选项。
最后，窗口名称似乎需要指针（仅在64位Office中）：
Dim dsktpHwnd As Long, hwnd As Long, mWnd As Long, cWnd As Long, wb As Object
需要成为：
Dim dsktpHwnd As LongPtr, hwnd As LongPtr, mWnd As LongPtr, cWnd As LongPtr, wb As Object