☰

vba Outlook Anhänge im CSV-Format speichern

tag-icon • tag-icon microsoft-excel microsoft-outlook vba csv
vba Outlook Anhänge im CSV-Format speichern

Ich versuche, einen Tabellenkalkulationsanhang im CSV-Format zu speichern.

Ich kann den Vorgang auslösen, wenn ein Tabellenkalkulationsanhang gefunden wird, aber es fällt mir schwer, dies mit einem Konvertierungsskript zu kombinieren, das zwei Argumente annimmt.

Speichern eines Anhangs

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-Format

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"

Die Idee istIf InStr(objAtt.DisplayName, ".xls")Wenn.xlsgefunden wird Dann

Konvertieren.xlsDatei in.csvUnd

Datei im Ordner speichernobjAtt.SaveAsFile saveFolder & "" & objAtt.DisplayName

Ich habe es so oft versucht, es hat nie funktioniert. Das Konvertierungsskript benötigt zwei Argumente. Verwendung: XlsToCsv SourcePath.xls Destination.csv"

Antwort1

Wenn Sie es nur speichern möchten alsVerwenden Sie im CSV-Format FileFormat:=xlCSV

Beispiel

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

Antwort2

Pfui!!! Ich hasse es, wenn Leute Code-Schnipsel posten, aber nicht das Ganze in bereinigter Form liefern ... :)

Wie dem auch sei, dank Ihrer gemeinsamen Arbeit konnte ich meine Aufgabe in weniger als einem Tag erledigen, also, hier ist es, Internet. KOSTENLOSER CODE.

Hinzugefügt:

  1. Ich habe es bereinigt und sogar eine Logik hinzugefügt, um die ersten zehn Zeilen aus dem Excel-Blatt zu löschen, da unser Datenauszug mit Überschriften versehen ist und es sich jetzt um eine SAUBERE CSV-Datei handelt.
  2. Ich habe ein Argument hinzugefügt, um die LOKALEN Einstellungen auf dem Computer zu verwenden, sodass Sie LIST DELIMITER in der SYSTEMSTEUERUNG unter REGIONALEINSTELLUNGEN beliebig einstellen können. Es wurde immer mit Komma-Trennzeichen gespeichert, unabhängig von meinen Systemeinstellungen, also sollte dies jetzt meine Systemeinstellungen respektieren und PIPE verwenden.
  3. Schließlich arbeite ich mit Office 2016 und musste sicherstellen, dass die EXCEL 16-BIBLIOTHEK zu den Referenzen hinzugefügt wurde.

VBA-Referenzen in Outlook

EINFACH PERFEKT!!!

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

verwandte Informationen