VBA Outlook сохранить вложения в формате CSV

Question

Я пытаюсь сохранить вложение электронной таблицы в формате CSV.

Я могу запустить процесс, когда вложение электронной таблицы найдено, но мне трудно совместить это со скриптом преобразования, который принимает два аргумента.

сохранение вложения

Public Sub saveAttachToDiskcvs(itm As Outlook.MailItem) 

 ' --> Settings. change to suit
Const MASK = "Olus" ' Value to be found
Const SHEET = "sheet2" ' Sheet name or its index where to find
 ' <--

 ' Excel constants
Const xlValues = -4163, xlWhole = 1, xlPart = 2 

 ' Variables
Dim objExcel As Object, IsNew As Boolean, x As Object 
Dim objAtt As Outlook.Attachment 
Dim saveFolder As String, sFileName As String, sPathName As String 
saveFolder = "C:\form" 

If Not TypeName(itm) = "MailItem" Then Exit Sub 
If Dir(saveFolder, vbDirectory) = "" Then MkDir saveFolder 

 ' Get/Create Excel object
On Error Resume Next 
Set objExcel = GetObject(, "Excel.Application") 
If Err Then 
    Err.Clear 
    IsNew = True 
    Set objExcel = CreateObject("Excel.Application") 
End If 
objExcel.FindFormat.Clear 

 ' Main
For Each objAtt In itm.Attachments 
    sFileName = LCase(objAtt.FileName) 
    If sFileName Like "*.xls" Or sFileName Like "*.xls?" Then 
        sPathName = saveFolder & "\" & sFileName 
        objAtt.SaveAsFile sPathName 
        With objExcel.workbooks.Open(sPathName, ReadOnly:=True) 
            Set x = .sheets(SHEET).UsedRange.Find(MASK, LookIn:=xlValues, LookAt:=xlPart) 
            If x Is Nothing Then Kill sPathName Else Set x = Nothing 
            .Close False 
        End With 
    End If 
Next 

If IsNew Then objExcel.Quit 

End Sub 

Формат CSV

if WScript.Arguments.Count < 2 Then
WScript.Echo "Error! Please specify the source path and the     
destination. Usage: XlsToCsv SourcePath.xls Destination.csv"
Wscript.Quit
End If
Dim oExcel
Set oExcel = CreateObject("Excel.Application")
Dim oBook
Set oBook = oExcel.Workbooks.Open(Wscript.Arguments.Item(0))
oBook.SaveAs WScript.Arguments.Item(1), 6
oBook.Close False
oExcel.Quit
WScript.Echo "Done"

Идея заключается в том, If InStr(objAtt.DisplayName, ".xls") если .xls найден

конвертировать .xls файл в .csv и

сохранить файл в папке objAtt.SaveAsFile saveFolder & "" & objAtt.DisplayName

Я пробовал так много раз, что это никогда не работало, сценарий преобразования принимает два аргумента. Использование: XlsToCsv SourcePath.xls Destination.csv "

Answer 1

Если вы хотите сохранить его только в формате CSV, используйте FileFormat:= xlCSV

---

пример

For Each objAtt In itm.Attachments
    sFileName = LCase(objAtt.FileName)
    If sFileName Like "*.xls" Or sFileName Like "*.xls?" Then
        sPathName = saveFolder & "\" & sFileName
        objAtt.SaveAsFile sPathName

        CVSName = Split(objAtt.FileName, ".")(0)

        Debug.Print CVSName

        CVSName = saveFolder & "\" & CVSName

        Debug.Print CVSName

        With objExcel.Workbooks.Open(sPathName)
            .SaveAs FileName:=CVSName, _
                    FileFormat:=xlCSV, _
                    CreateBackup:=False
            .Close SaveChanges:=True
        End With

        Kill sPathName
        objExcel.Quit
    End If
Next

Answer 2

Тьфу !!! Как сильно я ненавижу, когда люди публикуют отрывки кода, но не предоставляют всю вещь полностью очищенной ... :)

В любом случае, благодаря вашей совместной работе, я смог выполнить свою задачу менее чем за день, так что вы идете в Интернет. БЕСПЛАТНЫЙ КОД.

Добавлено:

1. Я очистил его и даже добавил некоторую логику для удаления первых десяти строк из листа Excel, потому что наш экстракт данных поставляется с заголовками, так что теперь это CLEAN CSV-файл.
2. Я добавил аргумент, чтобы использовать ЛОКАЛЬНЫЕ настройки на машине, чтобы вы могли установить РАЗДЕЛИТЕЛЬ СПИСКА на что угодно в ПАНЕЛИ УПРАВЛЕНИЯ в РЕГИОНАЛЬНЫХ НАСТРОЙКАХ. Он сохранял разделение COMMA независимо от настроек моей системы, поэтому теперь это должно соответствовать моим Системным настройкам и использовать ТРУБУ.
3. Наконец, я работаю с Office 2016, и мне нужно было убедиться, что БИБЛИОТЕКА EXCEL 16 была добавлена к ссылкам.

Ссылки VBA в Outlook

ПРОСТО ИДЕАЛЬНО !!!

Public Sub Convert_CSV(itm As Outlook.MailItem)

' Variables
Dim objExcel As Object, IsNew As Boolean
Dim objAtt As Outlook.Attachment
Dim saveFolder As String, sFileName As String, sPathName As String

' CONFGURE FOR YOUR DEPLOYMENT
saveFolder = "C:\inetpub\wwwroot\xls"

If Not TypeName(itm) = "MailItem" Then Exit Sub
If Dir(saveFolder, vbDirectory) = "" Then MkDir saveFolder

' Get/Create Excel object
On Error Resume Next
Set objExcel = GetObject(, "Excel.Application")
If Err Then
    Err.Clear
    IsNew = True
    Set objExcel = CreateObject("Excel.Application")
End If
objExcel.FindFormat.Clear

' Main
For Each objAtt In itm.Attachments
  sFileName = LCase(objAtt.FileName)
  If sFileName Like "*.xls" Or sFileName Like "*.xls?" Then
    sPathName = saveFolder & "\" & sFileName
    objAtt.SaveAsFile sPathName
    CVSName = Split(objAtt.FileName, ".")(0)
    CVSName = saveFolder & "\" & CVSName
    With objExcel.Workbooks.Open(sPathName)
      ' Delete first ten rows.
      For i = 1 To 10
        Rows(1).EntireRow.Delete
      Next

      .SaveAs FileName:=CVSName, _
        FileFormat:=xlCSV, _
        Local:=True, _
        CreateBackup:=False
      .Close SaveChanges:=True
    End With

    Kill sPathName
    objExcel.Quit
  End If
Next

If IsNew Then objExcel.Quit


Set objExcel = Nothing
Set objAtt = Nothing


End Sub