Outlook 宏将数据提取到 csv

Question

我想从电子邮件中提取数据并将其保存为 CSV。到目前为止，我所做的是将其转换为 excel，是否可以添加任何代码，以便在完成运行第一个宏后将其保存为 CSV。

Option Explicit

Sub CopyToExcel()
    Dim xlApp As Object
    Dim xlWB As Object
    Dim xlSheet As Object
    Dim olItem As Outlook.MailItem
    Dim vText As Variant
    Dim sText As String
    Dim vItem As Variant
    Dim i As Long
    Dim rCount As Long
    Dim bXStarted As Boolean
    Const strPath As String = "D:\My Documents\Vehicles.xlsx" 'the path of the workbook

    If Application.ActiveExplorer.Selection.Count = 0 Then
        MsgBox "No Items selected!", vbCritical, "Error"
        Exit Sub
    End If
    On Error Resume Next
    Set xlApp = GetObject(, "Excel.Application")
    If Err <> 0 Then
        Application.StatusBar = "Please wait while Excel source is opened ... "
        Set xlApp = CreateObject("Excel.Application")
        bXStarted = True
    End If
    On Error GoTo 0
    'Open the workbook to input the data
    Set xlWB = xlApp.Workbooks.Open(strPath)
    Set xlSheet = xlWB.Sheets("Sheet1")

    'Process each selected record
    For Each olItem In Application.ActiveExplorer.Selection
        sText = olItem.Body
        vText = Split(sText, Chr(13))
        'Find the next empty line of the worksheet
        rCount = xlSheet.UsedRange.Rows.Count
        rCount = rCount + 1

        'Check each line of text in the message body
        For i = UBound(vText) To 0 Step -1
            If InStr(1, vText(i), "A Card/Order") > 0 Then
                vItem = Split(vText(i), Chr(58))
                xlSheet.Range("D" & rCount) = Trim(vItem(1))
            End If

            If InStr(1, vText(i), "Required ShipDate:") > 0 Then
                vItem = Split(vText(i), Chr(58))
                xlSheet.Range("E" & rCount) = Trim(vItem(1))
            End If

            If InStr(1, vText(i), "Card Quantity:") > 0 Then
                vItem = Split(vText(i), Chr(58))
                xlSheet.Range("N" & rCount) = Trim(vItem(1))
            End If
        Next i
        xlSheet.Rows(1).Delete
        xlSheet.Range("A1").Value = "0"
        xlSheet.Range("B1").Value = "862"
        xlSheet.Range("C1").Value = "00-100-6360"

        xlSheet.Range("F1").Value = "0"
        xlSheet.Range("G1").Value = "0"
        xlSheet.Range("H1").Value = "0"
        xlSheet.Range("I1").Value = "0"
        xlSheet.Range("J1").Value = "0"
        xlSheet.Range("K1").Value = "0"
        xlSheet.Range("L1").Value = "0"
        xlSheet.Range("M1").Value = "0"
        xlSheet.Range("O1").Value = "0"
        xlSheet.Range("P1").Value = "0"
        xlSheet.Range("Q1").Value = "0"
        xlSheet.Range("R1").Value = "0"
        xlSheet.Range("S1").Value = "0"
        xlSheet.Range("T1").Value = "0"
        xlSheet.Range("U1").Value = "0"
        xlWB.Save
    Next olItem

    xlWB.Close SaveChanges:=True
    If bXStarted Then
        xlApp.Quit
    End If
    Set xlApp = Nothing
    Set xlWB = Nothing
    Set xlSheet = Nothing
    Set olItem = Nothing
End Sub

我试过了：

 ActiveWorkbook.SaveAs fileFormat:=xlCSV 

但这不会将文件保存为 CSV 。

参考：Social MSDN Forums

Answer 1

之前

xlWB.Close SaveChanges:=True

试试

xlWB.SaveAs fileFormat:=xlCSV

或者

xlWB.SaveAs fileFormat:=6