☰

vba outlook guardar archivos adjuntos en formato csv

tag-icon • tag-icon microsoft-excel microsoft-outlook vba csv
vba outlook guardar archivos adjuntos en formato csv

Estoy intentando guardar un archivo adjunto de hoja de cálculo en formato CSV.

Puedo activar el proceso cuando se encuentra un archivo adjunto de hoja de cálculo, pero me resulta difícil combinarlo con un script de conversión que requiere dos argumentos.

guardar un archivo adjunto

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

formato 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"

la idea esIf InStr(objAtt.DisplayName, ".xls")si.xlsse encuentra entonces

convertir.xlspresentar en.csvy

guardar el archivo en la carpetaobjAtt.SaveAsFile saveFolder & "" & objAtt.DisplayName

Lo intenté tantas veces que nunca funcionó, el script de conversión toma dos argumentos Uso: XlsToCsv SourcePath.xls Destination.csv"

Respuesta1

Si solo quieres guardarlo comoFormatee CSV y luego use FileFormat:=xlCSV

Ejemplo

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

Respuesta2

¡¡¡Puaj!!! Cuánto odio cuando la gente publica fragmentos de código, pero no proporcionan todo limpio... :)

De todos modos, gracias a vuestro trabajo conjunto pude completar mi tarea en menos de un día, así que aquí tenéis Internet. CÓDIGO GRATIS.

Agregado:

  1. Lo limpié e incluso agregué algo de lógica para eliminar las primeras diez filas de la hoja de Excel, porque nuestro extracto de datos viene con ENCABEZADOS, por lo que ahora es un archivo CSV LIMPIO.
  2. Agregué un argumento para usar la configuración LOCAL en la máquina, para que pueda configurar LIST DELIMITER en lo que desee en el PANEL DE CONTROL en CONFIGURACIÓN REGIONAL. Siguió guardando delimitado por COMA independientemente de la configuración de mi sistema, por lo que ahora esto debería respetar mi configuración del sistema y usar PIPE.
  3. Finalmente, estoy trabajando con Office 2016 y tuve que asegurarme de que la BIBLIOTECA EXCEL 16 estuviera agregada a las referencias.

Referencias de VBA en Outlook

¡¡¡SIMPLEMENTE PERFECTO!!!

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

información relacionada