☰

vba outlook сохраняет вложения в формате csv

tag-icon • tag-icon microsoft-excel microsoft-outlook vba csv
vba outlook сохраняет вложения в формате csv

Я пытаюсь сохранить вложение в виде электронной таблицы в формате 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"

решение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

решение2

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

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

Добавлен:

  1. Я очистил его и даже добавил некоторую логику для удаления первых десяти строк из таблицы Excel, поскольку наша выборка данных идет с ЗАГОЛОВКАМИ, так что теперь это ЧИСТЫЙ CSV-файл.
  2. Я добавил аргумент для использования ЛОКАЛЬНЫХ настроек на машине, так что вы можете установить РАЗДЕЛИТЕЛЬ СПИСКА на что угодно в ПАНЕЛИ УПРАВЛЕНИЯ в РЕГИОНАЛЬНЫХ НАСТРОЙКАХ. Он продолжал сохранять разделенные ЗАПЯТОЙ независимо от моих системных настроек, так что теперь это должно учитывать мои системные настройки и использовать PIPE.
  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

Связанный контент