Outlook에서 매크로의 Excel 첨부 파일을 저장, 정렬 및 정렬

Question

15 분마다 Outlook을 통해 보고서를받습니다. 이러한 보고서는 실제로 Excel 첨부 파일에 있습니다. 나는 하루 8 시간 밖에 일하지 않는다. 다음날 나는 보통 전날부터 매 15 분마다 보고서를 작성합니다. 그런 다음 각 보고서를 개별적으로 열고 헤더별로 정렬해야합니다.

나는 열고 각 읽지 않은 이메일 첨부 파일을 저장하고 내 컴퓨터에에 저장하는 방법을 알고 :

  Sub GetAttachments() 
      On Error GoTo GetAttachments_err 
      Dim ns As NameSpace 
      Dim Inbox As MAPIFolder 
      Dim SubFolder As MAPIFolder 
      Dim Item As Object 
      Dim Atmt As Attachment 
      Dim FileName As String 
      Dim i As Integer 

      Set ns = GetNamespace("MAPI") 
      Set Inbox = ns.GetDefaultFolder(olFolderInbox) 
      Set Mailbox = Inbox.Parent 
      Set SubFolder = Mailbox.Folders("Local Archive") 
      i = 0 

      'check if there is any mail in the folder' 
       If SubFolder.Items.Count = 0 Then 
       MsgBox "There are no messages in the folder.", vbInformation, _ 
       "Nothing Found" 
       Exit Sub 
       End If 

      'Check each message and save the attachment' 
      If SubFolder.Items.Count > 0 Then 
       For Each Item In SubFolder.Items 
       If Item.UnRead = True Then 
        For Each Atmt In Item.Attachments 
         FileName = "C:\Users\badana\Desktop\" & Atmt.FileName 
         Atmt.SaveAsFile FileName 'saves each attachment' 

         'this code opens each attachment' 
         Set myShell = CreateObject("WScript.Shell") 
         myShell.Run FileName 

         'this sets the email as read' 
         Item.UnRead = False 
         'updates the counter' 
         i = i + 1 

         Next Atmt 
        End If 
       Next Item 
      End If 

    'Display results 

    If i > 0 Then 
    MsgBox "I found " & i & " attached files." _ 
    & vbCrLf & "They are saved on your desktop" _ 
    & vbCrLf & vbCrLf & "Have a nice day.", vbInformation, "Finished!" 
    Else 
MsgBox "I didn't find any attached files in your mail.", vbInformation, _ 
"Finished!" 
End If 

     'Replenish Memory' 
     GetAttachments_exit: 

     Set Atmt = Nothing 
     Set Item = Nothing 
     Set ns = Nothing 
     Exit Sub 

'function for sorting the excel attachment' 


    GetAttachments_err: 
    MsgBox "An unexpected error has occurred." _ 
    & vbCrLf & "Please note and report the following information." _ 
    & vbCrLf & "Macro Name: GetAttachments" _ 
    & vbCrLf & "Error Number: " & Err.Number _ 
    & vbCrLf & "Error Description: " & Err.Description _ 
    , vbCritical, "Error!" 
    Resume GetAttachments_exit 
End Sub 

내가 헤더에 의해 각 첨부 파일 분류에 대한 코드가 있습니다 그러나

Sub SortData() 
' 
' SortData Macro 
' sorts data 
' 

' 
    Dim lngLast As Long 
    lngLast = Range("A" & Rows.Count).End(xlUp).Row 

    Cells.Select 
ActiveWorkbook.Worksheets("02APR14").Sort.SortFields.Clear 
ActiveWorkbook.Worksheets("02APR14").Sort.SortFields.Add Key:=Range("A2:A" & lngLast) _ 
    , SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal 
ActiveWorkbook.Worksheets("02APR14").Sort.SortFields.Add Key:=Range("K2:K" & lngLast) _ 
    , SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal 
With ActiveWorkbook.Worksheets("02APR14").Sort 
    .SetRange Range("A1:L" & lngLast) 
    .Header = xlYes 
    .MatchCase = False 
    .Orientation = xlTopToBottom 
    .SortMethod = xlPinYin 
    .Apply 
    End With 
End Sub 

을, Outlook에서 두 코드를 결합하여 Outlook에서 하나의 매크로로 실행할 수 있기를 원합니다. 모든 첨부 파일을 열고 저장하며 한 번에 정렬 할 수 있습니다. 이것이 가능한가?

Answer 1

정렬 데이터 매크로를 사용하고 파일 이름이 주어지면 파일을 여는 데 약간 편집했습니다.

방금 ​​저장 한 첨부 파일의 파일 이름을 사용하여 Outlook 매크로에서이를 호출해야합니다. 예. 당신의 savedown 코드에서이 줄을 삭제합니다

Set myShell = CreateObject("WScript.Shell") 
myShell.Run FileName 

및 교체 :

openAndSort(FileName) 

다음 코드

는 전망 VBA에서 같은 모듈에 추가 할 수 있습니다. 초기 바인딩을 사용하므로 엑셀 개체 라이브러리 (도구 -> 참조 -> Microsoft Excel 14 개체 라이브러리)에 대한 참조를 추가해야합니다.

Sub openAndSort(filename As String) 
' 
' 
' 
' 
Dim lngLast As Long 

Dim xl As Excel.Application 
Dim wb As Excel.Workbook 
Dim sh As Excel.Worksheet 
Set xl = New Excel.Application 
Set wb = xl.Workbooks.Open(filename) 
Set sh = wb.Worksheets("02APR14") 
xl.Visible = True 
    lngLast = sh.Range("A" & Rows.Count).End(xlUp).Row 

sh.Sort.SortFields.Clear 
sh.Sort.SortFields.Add Key:=sh.Range("A2:A" & lngLast) _ 
    , SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal 
sh.Sort.SortFields.Add Key:=sh.Range("K2:K" & lngLast) _ 
    , SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal 
With sh.Sort 
    .SetRange sh.Range("A1:L" & lngLast) 
    .Header = xlYes 
    .MatchCase = False 
    .Orientation = xlTopToBottom 
    .SortMethod = xlPinYin 
    .Apply 
End With 

wb.Save 
wb.Close 
Set wb = Nothing 
xl.Quit 
Set xl = Nothing 
End Sub