没问题！我们可以调整你的VBA代码，让它完成读取附件内容、筛选含"Error"的行并写入Excel的需求。先帮你梳理下原代码里的小问题，再给出完整的优化版本：

原代码的待调整点 #

• 缺少遍历邮件附件的循环（直接调用outlookAtch.SaveAsFile会因为未赋值报错）
• 没有处理附件内容的读取和筛选逻辑

优化后的完整代码 #

Option Explicit
Const AttachmentPath As String = "C:\users\maharaj\qalogs\"

Sub GetFromOutlook2()
    Dim outlookAtch As Attachment
    Dim NewFileName As String, filePath As String
    Dim OutlookApp As Outlook.Application
    Dim OutlookNamespace As Namespace
    Dim Folder As MAPIFolder
    Dim OutlookMail As Variant
    Dim i As Integer, rowNum As Integer
    Dim lineText As String
    
    ' 初始化Excel行号
    i = 1
    ' 创建Outlook对象
    Set OutlookApp = New Outlook.Application
    Set OutlookNamespace = OutlookApp.GetNamespace("MAPI")
    Set Folder = OutlookNamespace.GetDefaultFolder(olFolderInbox).Folders("QALOGS")
    
    For Each OutlookMail In Folder.Items
        ' 只处理指定日期之后的邮件
        If OutlookMail.ReceivedTime >= Range("start_Date").Value Then
            ' 写入邮件基础信息
            Range("email_Subject").Offset(i, 0).Value = OutlookMail.Subject
            Range("email_Date").Offset(i, 0).Value = OutlookMail.ReceivedTime
            Range("email_Sender").Offset(i, 0).Value = OutlookMail.SenderName
            Range("email_Body").Offset(i, 0).Value = OutlookMail.Body
            
            ' 遍历当前邮件的所有附件
            If OutlookMail.Attachments.Count > 0 Then
                For Each outlookAtch In OutlookMail.Attachments
                    ' 生成附件保存路径（避免重名，加上邮件接收时间的时分秒）
                    NewFileName = AttachmentPath & Format(OutlookMail.ReceivedTime, "DD-MM-YYYY-HH-MM-SS") & "-" & outlookAtch.Filename
                    outlookAtch.SaveAsFile NewFileName
                    ' 记录附件文件名到Excel
                    Range("email_attachment").Offset(i, 0).Value = outlookAtch.Filename
                    
                    ' 仅处理文本类日志文件（可根据需要添加扩展名，比如.log/.txt/.csv）
                    If LCase(Right(outlookAtch.Filename, 4)) = ".log" Or LCase(Right(outlookAtch.Filename, 4)) = ".txt" Then
                        filePath = NewFileName
                        ' 打开文件读取内容
                        Open filePath For Input As #1
                        rowNum = 0
                        ' 逐行读取并搜索"Error"
                        Do Until EOF(1)
                            Line Input #1, lineText
                            ' 不区分大小写搜索"Error"，如果找到就写入Excel
                            If InStr(1, lineText, "Error", vbTextCompare) > 0 Then
                                ' 可以把错误行写入单独的列，比如email_error_lines，或者追加到同一行的单元格
                                Range("email_error_lines").Offset(i + rowNum, 0).Value = lineText
                                rowNum = rowNum + 1
                            End If
                        Loop
                        Close #1
                    End If
                Next outlookAtch
            Else
                ' 如果没有附件，标记为空
                Range("email_attachment").Offset(i, 0).Value = "无附件"
            End If
            i = i + 1
        End If
    Next OutlookMail
    
    ' 释放对象
    Set Folder = Nothing
    Set OutlookNamespace = Nothing
    Set OutlookApp = Nothing
    MsgBox "处理完成！", vbInformation
End Sub

关键逻辑说明 #

1. 附件遍历：通过For Each outlookAtch In OutlookMail.Attachments循环处理每一封邮件的所有附件
2. 文件格式筛选：判断附件扩展名是否为.log/.txt（可根据实际日志格式调整）
3. 内容读取与筛选：
   • 用Open ... For Input打开日志文件，逐行读取
   • 用InStr(1, lineText, "Error", vbTextCompare)不区分大小写搜索包含"Error"的行
   • 找到的错误行会写入email_error_lines列（你需要在Excel里预先定义这个命名区域，或者替换成具体的单元格，比如Cells(i + rowNum, 6)）
4. 避免重名：附件文件名加上邮件接收时间的时分秒，防止同一天的同名附件覆盖

注意事项 #

• 确保Excel里已经定义了start_Date、email_Subject、email_Date、email_Sender、email_Body、email_attachment、email_error_lines这些命名区域，或者直接替换为单元格引用（比如Range("A2").Offset(i,0)）
• 如果日志文件是其他格式（比如.csv），可以调整文件读取逻辑
• 建议添加错误捕获（比如On Error Resume Next），避免因文件损坏导致代码中断

内容的提问来源于stack exchange，提问作者Maharaj