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