【问题标题】:To save attachments from outlook to a particular folder将附件从 Outlook 保存到特定文件夹
【发布时间】:2020-06-28 14:14:06
【问题描述】:

尝试将附件从 Outlook 保存到特定文件夹,代码将第一个附件保存在特定主目录中,但如果它有多个附件,则会留下其他附件。尝试使用循环但显示错误

Public Sub SaveAttachments()
Dim Folder As Outlook.MAPIFolder

Dim objOL As Outlook.Application
Dim objMsg As Outlook.MailItem 'Object
Dim objAttachments As Outlook.Attachments
Dim objSelection As Outlook.Selection
Dim MailBoxName         As String
Dim Pst_Folder_Name     As String
Dim Pst_SubFolder_Name     As String
Dim val
Dim strFile As String

 'Dim oOlAp As Object, oOlns As Object, oOlInb As Object
   ' Dim oOlItm As Object

Dim i As Long
Dim lngCount As Long
Dim strFolderpath As String

On Error GoTo ErrorHandler

MailBoxName = ActiveSheet.Cells(1, 2).Value
Pst_Folder_Name = ActiveSheet.Cells(2, 2).Value
If ActiveSheet.Cells(2, 3).Value <> "" Then
    Pst_SubFolder_Name = ActiveSheet.Cells(2, 3).Text
    Set Folder = Outlook.Session.Folders(MailBoxName).Folders(Pst_Folder_Name).Folders(Pst_SubFolder_Name)

Else
    Set Folder = Outlook.Session.Folders(MailBoxName).Folders(Pst_Folder_Name)

End If
val = 1


Dim myOutlook As Object: Set myOutlook = CreateObject("Outlook.application")
Dim myNameSpace As Object: Set myNameSpace = myOutlook.GetNamespace("MAPI")
'Dim MailFolder As Object: Set MailFolder = myNameSpace.Folders("Folder")

' Set the Attachment folder.
strFolderpath = "C:\Projects\Savefile\"

        '~~> Check if the email actually has an attachment
            For Each objMsg In Folder.Items

                If objMsg.Attachments.Count <> 0 Then
                    '''''For each statement
                    i = objMsg.Attachments.Count
                    '~~> Download the attachment
                        For val = 1 To i
                        Set objAttachments = objMsg.Attachments
                        strFile = strFolderpath & objAttachments.Item(val).Filename
                        objAttachments.Item(val).SaveAsFile strFile
            val = val + 1

            Next

            End If


ErrorHandler:
Resume Next

End Sub

【问题讨论】:

  • 你看到了什么错误?

标签: excel vba outlook


【解决方案1】:

如果您正在处理集合中未知数量的项目 - 请改用 For Each 循环:

For Each objAtt In objMsg.Attachments
    strFile = strFolderpath & objAtt.Filename
    objAtt.SaveAsFile strFile
Next

但要回答您的问题,具体到您现有的代码 - 摆脱这个:

val = val + 1

您已经在使用 val 作为循环变量,通过在循环内递增它,您每次都有效地跳过了一个数字:

For val = 1 To 10
    Debug.Print val
Next

输出:

1
2
3
4
5
6
7
8
9
10

For val = 1 To 10
    Debug.Print val
    val = val + 1
Next

输出:

1
3
5
7
9

【讨论】:

    猜你喜欢
    • 2019-03-17
    • 1970-01-01
    • 2022-12-14
    • 2014-07-18
    • 1970-01-01
    • 1970-01-01
    • 1970-01-01
    • 2016-06-29
    • 1970-01-01
    相关资源
    最近更新 更多