Question

我在excel中编写一个宏来将Outlook电子邮件导出到excel。代码工作正常但日期格式为“标记完成日期”。将数据导出为excel时，字段会更改。

在展望中，格式为＆＃34; dd-mm-yyyy hh：mm＆＃34; （例如：2015年1月21日12:42）。将电子邮件导出为Excel时，此字段的格式将更改为2015年1月21日00:00

还有其他日期字段，其格式正确显示在Excel中。只有这个字段有格式问题。

请帮忙！

谢谢！ KSP

以下是我正在使用的代码：

Sub InboxToExcel()

    Dim objOL As Outlook.Application
    Dim objNS As Outlook.Namespace
    Dim objInbox As Outlook.Folder
    Dim objTable As Outlook.Table
    Dim objRow As Outlook.Row
    Dim objMsg As Outlook.MailItem
    Dim objWB As Excel.Workbook
    Dim objWS As Excel.Worksheet
    Dim objRange As Excel.Range
    Dim strFind As String
    Dim strProps As String
    Dim arr() As String
    Dim val As Variant
    Dim i As Integer
    Dim intRow As Integer

    strProps = _
      "SenderName,To,Subject,SentOn,ReadReceiptRequested"
    Set objOL = Application
    Set objNS = objOL.Session
    Set objInbox = objNS.GetDefaultFolder(olFolderInbox)
    Set objTable = objInbox.GetTable

    Set objWB = GetExcelWB()
    Set objWS = objWB.Sheets(1)
    objWS.Name = "Inbox"
    arr = Split(strProps, ",")
    intRow = 1
    For i = 0 To UBound(arr)
        objWS.Cells(intRow, i + 1) = arr(i)
        objTable.Columns.Add arr(i)
    Next
    Set objRange = objWS.Range _
                   (objWS.Cells(1, 1), objWS.Cells(1, i + 1))
    objRange.Font.Bold = True
    Do Until objTable.EndOfTable
        intRow = intRow + 1
        Set objRow = objTable.GetNextRow
        For i = 0 To UBound(arr)
            val = objRow(arr(i))
        Select Case VarType(val)
           Case vbDate
                val = DateToExcel(val)
           Case vbBoolean
                val = YesNoToString(val)
        End Select
            objWS.Cells(intRow, i + 1) = val
        Next
    Loop
    For i = 1 To (UBound(arr) + 1)
        objWS.Columns(i).EntireColumn.AutoFit
    Next
    objWS.Application.Visible = True
    objWS.Activate
    Set objOL = Nothing
    Set objNS = Nothing
    Set objRow = Nothing
    Set objWB = Nothing
    Set objWS = Nothing
    Set objRange = Nothing
End Sub

Function DateToExcel(propVal)
    Dim dteDate 'As Date
    If IsDate(propVal) Then
        dteDate = CDate(propVal)
        If dteDate = #1/1/4501# Then
            DateToExcel = Null
        Else
            DateToExcel = dteDate
        End If
    End If
End Function
Function YesNoToString(propVal)
    If propVal = "True" Then
        YesNoToString = "Yes"
    Else
        YesNoToString = "No"
    End If
End Function

Outlook标记excel中的完成日期格式

0 个答案: