2016-07-28 103 views
0

我有這段代碼用於將附件從電子郵件保存到指定文件夾。但我想在保存之前轉換這些文件。特別是xls文件到xlsx。使用VBA保存和轉換附加的Outlook文件

有人能幫助我嗎?

Public Sub saveAttachtoDisk(itm As Outlook.MailItem) 
     Dim objAtt As Outlook.Attachment 
     Dim saveFolder As String 
     Dim dateFormat As String 

     dateFormat = Format(Now, "yyyy-mm-dd H-mm") 
     saveFolder = "C:\Users\gabor\Documents\CAFM\xml\" 
     For Each objAtt In itm.Attachments 
      If InStr(objAtt.DisplayName, ".xml") Then 
      objAtt.SaveAsFile saveFolder & "\" & objAtt.DisplayName 
      End If 

      Set objAtt = Nothing 
     Next 
End Sub 
+0

你可能就需要在Excel中第一次打開他們 - 然後做一個另存爲。你可以通過錄制一個宏來獲得一些示例代碼 – dbmitch

+0

您是從Excel還是從Outlook運行此代碼?看起來它可能是Excel,因爲你已經將'itm完全限定爲Outlook.MailItem',在這種情況下打開/保存文件會稍微簡單一些。 –

回答

0

我做到了。

Public Sub saveconvAttachtoDisk(itm As Outlook.MailItem) 

Dim objAtt As Outlook.Attachment 
Dim saveFolder As String 
Dim dateFormat As String 
Dim convFormat As String 
Dim objFSO As Object 
Dim objFolder As Object 
Dim objFile As Object 

saveFolder = "C:\Users\gabor\Documents\CAFM\xml\" 
convFolder = "C:\Users\gabor\Documents\CAFM\xls\" 
dateFormat = Format(Now, "yyyy-mm-dd HH-mm-ss") 

For Each objAtt In itm.Attachments 

objAtt.SaveAsFile saveFolder & dateFormat & objAtt.FileName 

Set objFSO = CreateObject("Scripting.FileSystemObject") 
Set objFolder = objFSO.GetFolder(saveFolder) 
    If UCase(Right(objAtt.FileName, Len(XML))) = UCase(XML) Then 
     NewFileName = convFolder & dateFormat & objAtt.FileName & "_conv.xlsx" 

Set ConvertThis = Workbooks.Open(saveFolder & dateFormat & objAtt.FileName) 
     ConvertThis.SaveAs FileName:=NewFileName, FileFormat:= _ 
     xlOpenXMLWorkbook 
     ConvertThis.Close 
    End If 
Next 
Set objAtt = Nothing 

末次

相關問題