使用VBA从Outlook 2010保存.XLSX附件 [英] Saving .XLSX Attachments from Outlook 2010 w/ VBA
问题描述
我们使用Outlook 2010,并接收带有Excel附件的电子邮件.我们将附件手动保存在我们在网络驱动器的分区文件夹中创建的子文件夹中.
We use Outlook 2010 and receive emails with Excel attachments. We manually save the attachment in a sub-folder that we create within a divisional folder on a network drive.
我很好奇的是是否有可能
What I'm curious about is if it's possible to
- 使用代码检查收到的电子邮件中是否有附件,
- 然后检查附件是否为.XLSX
- 如果是这样,请打开附件,检查特定单元格的值,
- 然后将帐户名和帐号存储为字符串和变量
- 然后使用它们在相应的Windows目录中创建子文件夹.
**我忘了发布到目前为止所做的事情.我相信Brett回答了我的??,但也许其他人也可以使用它的摘要.
** I forgot to post what I had done so far. I believe Brett answered my ??, but maybe someone else would be able to use snippets of it.
Private Sub cmdConnectToOutlook_Click()
Dim appOutlook As Outlook.Application
Dim ns As Outlook.Namespace
Dim inbox As Outlook.MAPIFolder
Dim item As Object
Dim atmt As Outlook.Attachment
Dim filename As String
Dim i As Integer
Set appOutlook = GetObject(, "Outlook.Application")
Set ns = appOutlook.GetNamespace("MAPI")
Set inbox = ns.GetDefaultFolder(olFolderInbox)
i = 0
If inbox.Items.Count = 0 Then
MsgBox "There are no messages in the Inbox.", vbInformation, _
"Nothing Found"
Exit Sub
End If
For Each item In inbox.Items
For Each atmt In item.Attachments
If Right(atmt.filename, 4) = "xlsx" Then
filename = "\\temp\" & atmt.filename
atmt.SaveAsFile filename
i = i + 1
End If
Next atmt
Next item
MsgBox "Attachments have been saved.", vbInformation, "Finished"
Set atmt = Nothing
Set item = Nothing
Set ns = Nothing
结束子
推荐答案
在这里说很长,是解决问题的一种方法.我来自 VBA代码的代码,该代码用于将另一封电子邮件中的Outlook电子邮件中的附件(excel文件)保存为附件也很有趣
Having said it is lengthy here is one way to do it. My code from VBA Code to save an attachment (excel file) from an Outlook email that was inside another email as an attachment may also be of interest
您将需要更新文件路径以及正在打开的文件中的单元格范围
You will need to update your file path, and the cell range from the file that you are opening
在测试中,我通过第一张工作表A1中的pdf文件和excel工作簿(带有"bob")向自己发送了一条消息
In my testing I sent a message to myself with a pdf file and an excel workbook with "bob" in the A1 in the first sheet
下面的代码找到了excel文件,将其保存,打开,创建目录c:\temp\bob
,然后杀死已保存的文件
The code below found the excel file, saved it, opened it, create a directory c:\temp\bob
then killed the saved file
Private Sub Application_NewMailEx _
(ByVal EntryIDCollection As String)
'Uses the new mail techniquer from http://www.outlookcode.com/article.aspx?id=62
Dim arr() As String
Dim lngCnt As Long
Dim olAtt As Attachment
Dim strFolder As String
Dim strFileName As String
Dim strNewFolder
Dim olns As Outlook.NameSpace
Dim olItem As MailItem
Dim objExcel As Object
Dim objWB As Object
'Open Excel in the background
Set objExcel = CreateObject("excel.application")
'Set working folder
strFolder = "c:\temp"
On Error Resume Next
Set olns = Application.Session
arr = Split(EntryIDCollection, ",")
On Error GoTo 0
For lngCnt = 0 To UBound(arr)
Set olItem = olns.GetItemFromID(arr(lngCnt))
'Check new item is a mail message
If olItem.Class = olMail Then
'Force code to count attachments
DoEvents
For Each olAtt In olItem.Attachments
'Check attachments have at least 5 characters before matching a ".xlsx" string
If Len(olAtt.FileName) >= 5 Then
If Right$(olAtt.FileName, 5) = ".xlsx" Then
strFileName = strFolder & "\" & olAtt.FileName
'Save xl attachemnt to working folder
olAtt.SaveAsFile strFileName
On Error Resume Next
'Open excel workbook and make a sub directory in the working folder with the value from A1 of the first sheet
Set objWB = objExcel.Workbooks.Open(strFileName)
MkDir strFolder & "\" & objWB.sheets(1).Range("A1")
'Close the xl file
objWB.Close False
'Delete the saved attachment
Kill strFileName
On Error Goto 0
End If
End If
Next
End If
Next
'tidy up
Set olns = Nothing
Set olItem = Nothing
objExcel.Quit
Set objExcel = Nothing
End Sub
这篇关于使用VBA从Outlook 2010保存.XLSX附件的文章就介绍到这了,希望我们推荐的答案对大家有所帮助,也希望大家多多支持IT屋!