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.
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 are all defined in Check to see if Excel is open (from another Office 2010 App) and are the same in my code.
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!
Thanks in advance.
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)
needs to become:
Set srcWorkbook = wb.Parent.Application.Workbooks.Open(attachFileName)
And for the second in some installations of Excel:
cWnd = FindWindowEx(mWnd, 0&, "EXCEL7", "Test Workbook.xlsx")
may need to become:
cWnd = FindWindowEx(mWnd, 0&, "EXCEL7", "Test Workbook")
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.
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
needs to become:
Dim dsktpHwnd As LongPtr, hwnd As LongPtr, mWnd As LongPtr, cWnd As LongPtr, wb As Object
The technical post webpages of this site follow the CC BY-SA 4.0 protocol. If you need to reprint, please indicate the site URL or the original address.Any question please contact:yoyou2525@163.com.