☰

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 시트에서 처음 10개 행을 삭제하는 논리도 추가했습니다. 데이터 추출이 HEADERS와 함께 제공되므로 이제 CLEAN CSV 파일이 되기 때문입니다.
  2. 머신에서 LOCAL 설정을 사용하는 인수를 추가했으므로 REGIONAL SETTINGS 아래의 제어판에서 원하는 대로 LIST DELIMITER를 설정할 수 있습니다. 내 시스템 설정에 관계없이 계속 쉼표로 구분되어 저장되었으므로 이제 내 시스템 설정을 존중하고 PIPE를 사용해야 합니다.
  3. 마지막으로 저는 Office 2016을 사용하여 작업하고 있으며 EXCEL 16 LIBRARY가 참조에 추가되었는지 확인해야 했습니다.

Outlook의 VBA 참조

정말 완벽해요!!!

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

관련 정보