在Excel窗口中打开附件并复制以打开工作簿 [英] Open attachment in excel window and copy to open workbook

问题描述

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

Using outlook VBA - I would like to open an attachment in a particular instance of excel, and then copy the sheets from that attachment into an open workbook.

我已经使用了(>保存Outlook的几个代码段附件，其日期在文件名中和

I've used a couple of code snippets from (Saving Outlook attachment with date in the filename and Check to see if Excel is open (from another Office 2010 App) to save an attachment from an email and then find the excel window I need to open it in - both work in isolated outlook test macros.

麻烦的是，我似乎无法将这两部分链接到工作代码中，而在所有这些代码的结尾，我都有:

Trouble is, I can't seem to link the two parts together into working code, at the end of all of it I have:

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均在

SetIDispatch, Findwindowex, accessibleobjectfromwindow are all defined in Check to see if Excel is open (from another Office 2010 App) and are the same in my code.

最后一行失败，出现运行时错误438:对象不支持此属性或方法.这向我表明我可能正在吠叫错误的树-恐怕我不知道要瞄准哪棵树！

The last line fails, with runtime error 438: Object doesn't support this property or method. This suggests to me that I'm probably barking up the wrong tree - I'm afraid though that I've no idea which tree to aim for!

谢谢.

推荐答案

两个问题: AccessibleObjectFromWindow 返回 Window 对象和 Open 方法是 Application.Workbooks 的成员；并且窗口标题没有文件扩展名.

Two problems: AccessibleObjectFromWindow returns a Window object and the Open method is a member of Application.Workbooks; and the window title doesn't have the file extension.

因此要解决第一个问题:

So to solve the first issue:

Set srcWorkbook = wb.Application.Open(attachFileName)

需要成为:

Set srcWorkbook = wb.Parent.Application.Workbooks.Open(attachFileName)

第二次安装Excel:

And for the second in some installations of Excel:

cWnd = FindWindowEx(mWnd, 0&, "EXCEL7", "Test Workbook.xlsx")

可能需要成为:

cWnd = FindWindowEx(mWnd, 0&, "EXCEL7", "Test Workbook")

供将来的读者使用的注意事项:这似乎取决于Windows和Excel版本，以及是否在Windows资源管理器选项中启用隐藏已知文件扩展名".

Note for future readers: This appears to depend on Windows and Excel versions, and whether or not you enable the "Hide known file extensions" in the windows explorer options.

最后，似乎窗口名称需要是指针(仅在64位Office中):

Finally it seems that the window names need to be pointers (in 64-bit Office only):

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

这篇关于在Excel窗口中打开附件并复制以打开工作簿的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持IT屋！