我太懂这种崩溃的感觉了！Outlook这个日期格式随邮件年龄自动变的设计，简直是数据整理的噩梦——老邮件是dd/mm/yyyy，本周的是ddd dd/mm，当天的直接变成ddd hh:mm，导入Excel后完全没法正常排序。你的VBA思路方向完全对，只是有些细节没处理到位，咱们来把这个函数修复好：

先说说原函数的几个小问题 #

• 你用到了IsADigit和HowManyOfThese两个辅助函数，但没定义它们，运行时Excel会直接报错
• 函数返回的是String类型，就算转换对了，Excel也只会当作文本，没法按日期排序
• 本周日期的处理逻辑没正确计算具体日期（只取了当前年份，但没根据星期几推算正确的日期）
• 当天的情况只返回了日期，没保留时间信息

修复后的完整VBA代码 #

' 辅助函数：判断单个字符是否为数字
Function IsADigit(c As String) As Boolean
    IsADigit = c Like "[0-9]"
End Function

' 辅助函数：统计字符串中指定字符的出现次数
Function HowManyOfThese(str As String, char As String) As Integer
    If str = "" Then
        HowManyOfThese = 0
        Exit Function
    End If
    HowManyOfThese = UBound(Split(str, char))
End Function

Public Function DateFromOutlook(myDate As String) As Date
    ' 转换Outlook的多种日期格式为Excel可识别的日期时间值
    ' 支持格式：
    ' 1. 老邮件：dd/mm/yyyy
    ' 2. 本周邮件：ddd dd/mm
    ' 3. 当天邮件：ddd hh:mm
    
    Dim currentYear As Integer
    Dim parsedDate As Date
    
    currentYear = Year(Date) ' 获取当前年份，用于补全本周邮件的年份
    
    ' 情况1：老邮件，以数字开头（dd/mm/yyyy格式）
    If IsADigit(Left(myDate, 1)) Then
        ' 替换斜杠为减号，确保Excel能识别为日期
        parsedDate = DateValue(Replace(myDate, "/", "-"))
    ' 情况2：本周邮件，包含1个斜杠（ddd dd/mm格式）
    ElseIf HowManyOfThese(myDate, "/") = 1 Then
        Dim dayPart As String, monthPart As String
        dayPart = Mid(myDate, 5, 2) ' 提取dd部分
        monthPart = Right(myDate, 2) ' 提取mm部分
        
        ' 先构造当前年份的日期，再调整到正确的星期
        parsedDate = DateSerial(currentYear, monthPart, dayPart)
        
        ' 处理跨周情况（比如本周一的邮件，避免被算成下周一）
        If parsedDate > Date Then
            parsedDate = parsedDate - 7
        End If
    ' 情况3：当天邮件，包含1个冒号（ddd hh:mm格式）
    ElseIf HowManyOfThese(myDate, ":") = 1 Then
        Dim timePart As String
        timePart = Right(myDate, 5) ' 提取hh:mm部分
        ' 组合当前日期和时间，形成完整的日期时间值
        parsedDate = Date + TimeValue(timePart)
    Else
        ' 遇到未知格式，返回错误值，方便排查特殊情况
        DateFromOutlook = CVErr(xlErrValue)
        Exit Function
    End If
    
    DateFromOutlook = parsedDate
End Function

关键修复点说明 #

1. 返回类型改为Date：这样Excel会把结果当作真正的日期时间值，而不是文本，直接就能参与排序、筛选等操作
2. 补充缺失的辅助函数：把原函数依赖的IsADigit和HowManyOfThese补全，不用再单独定义
3. 本周日期的精准推算：不仅补全年份，还会自动调整跨周问题（比如避免把本周一的邮件日期算成下周一）
4. 保留当天邮件的时间：不再只返回当前日期，而是组合成完整的日期时间值，时间信息也能用上
5. 增加错误处理：遇到未知格式的日期会返回错误值，方便你快速定位特殊情况

使用方法 #

1. 打开Excel，按Alt + F11打开VBA编辑器
2. 右键你的工作簿 → 插入 → 模块，新建一个空白模块
3. 把上面的代码粘贴进去，保存文件为.xlsm格式（必须是启用宏的工作簿）
4. 在Excel单元格中输入公式：=DateFromOutlook(你的Outlook日期单元格)，比如=DateFromOutlook(C2)
5. 把公式结果的单元格格式设置为你需要的样式（比如yyyy/mm/dd hh:mm），现在就可以正常按日期排序啦！

如果还有特殊格式的日期没覆盖到，把那个日期内容告诉我，咱们再微调函数~