Перспективы VBA - Msg.SaveAs «Путь» вопрос

Question

Привет всем,

Я написал код, который экономит MailItem в папке.

Он работал отлично, за исключением проблемы: несколько раз Outlook не ответил, и мне пришлось закрыть его с помощью Ending Task.

Во-первых, я думал, что это из-за размера файла. Затем я узнал, что эта проблема связана с длиной MailItem. Когда сообщение слишком длинное, Outlook не отвечает и я должен его закрыть.

Может кто-нибудь мне помочь?

Кодекс:

Private Sub CommandButton3_Click() 

Unload Me 

Dim Path As String 
Dim Mes As String 
Dim Hoje As String 
Dim Usuario As String 
Dim Diretorio As String 
Dim olApp As Object 
Dim olNs As Object 



'Path do servidor 
Path = "\\Brsplndowd009\DMS_BPSC_LAA\Customer_Service\Unapproved\Samples\Sample Orders - 2014" 
'Mes 
Mes = Mid(Date, 4, 2) 
'Data 
Hoje = Left(Date, 2) & UCase(Left(MonthName(Mes), 3)) & Right(Date, 2) 
'Usuário 
    Usuario = "LEVY" 


'1. Nome da Pasta 

Diretorio = Path & "\" & Source & "\" & Tracking & " - " & Customer & " - " & Material & " - " & Hoje & " - " & Usuario 


'Dim Msg As Outlook.MailItem' 
Dim Msg As Object 
Dim Att As Outlook.Attachment 
Dim olConc As Outlook.Folder 
Dim olConc2 As Outlook.Folder 
Dim olItms As Outlook.Items 


'Get Outlook 
Set olApp = GetObject(, "Outlook.application") 
Set olNs = olApp.GetNamespace("MAPI") 
Set olItms = GetFolder("Caixa de correio - FLHSMPL\Inbox\00-Levy").Items 
Set olConc2 = GetFolder("Caixa de correio - FLHSMPL\Inbox\00-Levy") 
Set olConc = GetFolder("Caixa de correio - FLHSMPL\Inbox\00-Levy\Encerrar") 


'Loop 

    For Each Msg In olItms 

    If InStr(1, Msg.Subject, Tracking) > 0 Then MkDir Diretorio 
    If InStr(1, Msg.Subject, Tracking) > 0 Then Msg.Move olConc 
    If InStr(1, Msg.Subject, Tracking) > 0 Then Msg.SaveAs Diretorio & "\" & "Caso" & " " & Tracking & ".msg" 

    If InStr(1, Msg.Subject, Tracking) > 0 Then Success.Show 
    If InStr(1, Msg.Subject, Tracking) > 0 Then Exit Sub 


    Next Msg 


Fail.Show 

End Sub 

Answer 1

Во-первых, я ма не знаю, почему у вас есть 5 Если заявления с тем же условием. Wjy не сворачивать их в один?

Во-вторых, вы вызываете «Переместить», а затем попробуйте исходное сообщение. Вы не можете этого сделать - старый предмет ушел. Вам необходимо использовать новую, полученную с помощью Move:

If InStr(1, Msg.Subject, Tracking) > 0 Then 
    MkDir Diretorio 
    set Msg = Msg.Move(olConc) 
    Msg.SaveAs Diretorio & "\" & "Caso" & " " & Tracking & ".msg" 
    Success.Show 
    Exit Sub 
End If