Vba 保存outlook excel附件并连接数据

我有一个要求，那就是我每天都在做，并且花大约3个小时去做。我想它是自动化的，这样我可以节省时间

每天我都会收到一封电子邮件，其中包含大约100封*.msg格式的附件（附件实际上是来自不同供应商的邮件）

在*.msg文件中，将有一个Excel文件，该Excel文件包含一行数据

我想做的是提取第一个电子邮件附件（以.Msg格式），提取每个.Msg附件中的Excel文件，然后将XLS文件中的数据复制到新的Excel文件中（合并每个Excel附件中的数据以进行计算）

---

有人能提供一种在vba宏中自动执行此过程的方法吗？我需要详细的步骤，因为我是编码领域的新手。

这是我能用vba自动完成的最接近的步骤。这是一种半自动的解决方案，要求您先将.msg附件保存在文件夹中，然后手动将其全部打开（即全选，右键单击其中一个并选择“打开”）。我在98封一次打开的邮件上进行了测试，我的Outlook在快结束时慢了一点，但没有崩溃。代码本身在3分钟内完成任务。 但首先，根据提供的信息做出了一些假设：

• 所有.msg附件都在一封电子邮件中-如果不是，您可能需要根据需要重复步骤1
• .msg文件中的Excel文件采用“.xls”格式。如果它们是“.xlsx”或其他Excel格式，只需修改步骤3下的相关代码行即可
• 您声明Excel文件只包含1行数据-下面假设它是第1页的第1行。如果没有，代码需要在工作之前稍微调整一下
• 此外，该解决方案会忽略Excel文件中的单元格格式-仅复制单元格中的值-如果需要，可以修改此设置
• 您对VBA有一些了解，知道如何在VB编辑器中插入模块、编译、运行和编辑代码-如果没有，请在下面的评论中发表您的问题，我很乐意进一步提供帮助

解决方案：

步骤1-将所有“.msg”附件保存到文件夹中

第2步-选择文件夹中的所有电子邮件并打开它们-这将打开多个Outlook inspector窗口

步骤3-在Excel中，激活VB编辑器并将以下代码粘贴到模块中：

Sub GetAttachments()
'loops through Outlook inspector windows extracting .xls attachments into a folder

    Dim oShell As Object
    Dim olApp As Object
    Dim Insp As Object
    Dim Att As Object
    Dim FldPth As String
    Dim myFname As String
    Dim i As Long

    Set olApp = CreateObject("Outlook.Application")
    Set oShell = CreateObject("Shell.Application").BrowseForFolder(0, "Select Folder with attachments", 0)
    If oShell Is Nothing Then MsgBox "Folder was not selected", vbCritical: Exit Sub

    FldPth = oShell.self.Path

    'loop through open outlook windows (inspectors)
    'use reversed loop, otherwise every second iteration will be skipped
    For i = olApp.Inspectors.Count To 1 Step -1
        Set Insp = olApp.Inspectors.Item(i)
        'loop through attachments in the email message
        For Each Att In Insp.CurrentItem.Attachments
            myFname = Att.Filename

            'if the attached file is an xls type, save it in a folder
            If LCase(Right(myFname, 4)) = ".xls" Then
                Att.SaveAsFile FldPth & "\" & myFname
            End If
        Next Att
        'close the inspector window
        Insp.Close olDiscard
    Next i
    Set oShell = Nothing
    Set olApp = Nothing
    MsgBox "Done!"
End Sub
Sub GetDataFromWbks()
'loops through Excel files in selected folder extracting data from first row in sheet 1 into active worksheet

    Dim oShell As Object
    Dim FSO As Object
    Dim f As Object
    Dim srcWbk As Workbook
    Dim dstWs As Worksheet
    Dim srcRng As Range
    Dim dstRng As Range
    Dim FldPth As String
    Dim i As Long

    Set oShell = CreateObject("Shell.Application").BrowseForFolder(0, "Select Folder with attachments", 0)
    If oShell Is Nothing Then MsgBox "Folder was not selected", vbCritical: Exit Sub
    FldPth = oShell.self.Path

    Set dstWs = ActiveSheet
    Set dstRng = dstWs.Rows(1)
    Set FSO = CreateObject("Scripting.FileSystemObject")
    Application.ScreenUpdating = False

    'loop through all files in folder
    For Each f In FSO.GetFolder(FldPth).Files
        If LCase(Right(f.Name, 4)) = ".xls" Then
            'show progress in Excel's status bar
            Application.StatusBar = i
            'open xls file
            Set srcWbk = Workbooks.Open(f.Path)
            'set source range
            Set srcRng = srcWbk.Sheets(1).UsedRange.Rows(1)
            'copy source range to destination range
            dstWs.Range(srcRng.Address).Offset(i).Value = srcRng.Value
            i = i + 1
            'close workbook
            srcWbk.Close
        End If
    Next f
    Application.ScreenUpdating = True
    Application.StatusBar = False
    Set FSO = Nothing
    Set oShell = Nothing
    MsgBox "Done!"
End Sub

步骤4-运行“GetAttachments”过程。出现提示时，选择保存附件的文件夹。该过程应将.msg文件中的所有Excel附件提取到同一文件夹中

第5步-一旦完成（弹出框出现），激活要将数据复制到的Excel工作表（我建议您在此处使用新的空工作表），并运行“GetDataFromWbks”过程-再次，在提示时选择您的文件夹。您可以在Excel的状态栏中查看进度

---

第六步-就是这样，享受节省下来的时间

太棒了！！我尝试了第一轮测试，它的效果非常好…非常感谢@JK2017，我会做更多的测试，如果有任何问题，我会让你知道。再次非常感谢：）：）请允许我询问，在通过“GetDataFromWbks”过程打印数据之前，是否有任何方法可以硬编码第1行中的标题。是的，您当然可以添加任何需要的标题。尝试以下操作：打开Excel的宏记录器并添加所需的标题、应用格式等。然后停止记录器，转到VB编辑器，检查记录器生成的代码。此时，我建议将Excel工作表和VBE并排放在屏幕上，删除标题并用F8再次遍历代码，以查看每行代码的作用。宏记录器生成的代码通常有点过多，即在单元格中添加值时，记录器至少使用两行代码，即

范围(“A1”）。选择
和
ActiveCell.FormulaR1C1=“示例标题”
您可以将其更改为
范围（“A1”）.Value=“示例标题”
（在更改单元格的值之前无需选择单元格）。根据需要编辑记录的代码，然后可以在两个过程之间调用它。确保“过程开始从第2行而不是第1行添加数据，只需将此行上移一行即可。谢谢。我已经将标题设置为
Range（“A1”）.Value=“example Header”
，并且工作正常。