0

大家好，

我编写了一个将邮件项保存在文件夹中的代码。

它工作得很好，除了一个问题：有几次，Outlook 没有响应，我不得不通过结束任务关闭它。

起初，我以为是因为文件大小。然后，我发现这个问题是由于 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
4

1 回答 1

1

首先，我不确定为什么您有 5 个条件相同的 If 语句。Wjy不把它们合二为一吗？

其次，您正在调用 Move，然后尝试向我们发送原始消息。你不能那样做 - 旧物品不见了。您需要使用 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
于 2014-11-14T18:00:13.383 回答