在Outlook 2013中自动打印时出现文件访问错误

Question

我有以下代码，可以在收到电子邮件时自动打印我的pdf。我时不时会收到一个文件访问错误，它会阻止所有电子邮件被检查。大多数情况下，当它发生时会发生多次。

我试过几件事，但还是时不时会出错。

Sub LSPrint(Item As Outlook.MailItem)
    On Error GoTo OError
    'detect Temp
    Dim oFS As FileSystemObject
    Dim sTempFolder As String
    Set oFS = CreateObject("Scripting.FileSystemObject")
    'Temporary Folder Path
    sTempFolder = oFS.GetSpecialFolder(TemporaryFolder)
    'creates a special temp folder
    cTmpFld = sTempFolder & "OETMP" & Format(Now, "yyyymmddhhmmss")
    MkDir (cTmpFld)
    'save & print
    Dim oAtt As Attachment
    For Each oAtt In Item.Attachments
      FileName = oAtt.FileName
      fullfile = cTmpFld & "" & FileName
      'save attachment
      oAtt.SaveAsFile (fullfile)
      'prints attachment
      Set objShell = CreateObject("Shell.Application")
      Set objFolder = objShell.NameSpace(0)
      Set objFolderItem = objFolder.ParseName(fullfile)
      objFolderItem.InvokeVerbEx ("print")
    Next oAtt
    'Cleanup
    If Not oFS Is Nothing Then Set oFS = Nothing
    If Not objFolder Is Nothing Then Set objFolder = Nothing
    If Not objFolderItem Is Nothing Then Set objFolderItem = Nothing
    If Not objShell Is Nothing Then Set objShell = Nothing
OError:
    If Err <> 0 Then
      MsgBox Err.Number & " - " & Err.Description
      Err.Clear
    End If
    Exit Sub
  End Sub

Answer 1

可能文件尚未完成保存。

Sub LSPrint(Item As Outlook.MailItem)
    ' Remove this line to determine the line with the error
    ' On Error GoTo OError
    dim i as long
    'detect Temp
    Dim oFS As FileSystemObject
    Dim sTempFolder As String
    Set oFS = CreateObject("Scripting.FileSystemObject")
    'Temporary Folder Path
    sTempFolder = oFS.GetSpecialFolder(TemporaryFolder)
    'creates a special temp folder
    cTmpFld = sTempFolder & "OETMP" & Format(Now, "yyyymmddhhmmss")
    MkDir (cTmpFld)
    'save & print
    Dim oAtt As Attachment
    For Each oAtt In Item.Attachments
        FileName = oAtt.FileName
        fullfile = cTmpFld & "" & FileName
        'save attachment
        oAtt.SaveAsFile (fullfile)
        'prints attachment
        Set objShell = CreateObject("Shell.Application")
        Set objFolder = objShell.NameSpace(0)
        On Error GoTo OErrorDelay
        ' Assuming it is the line with the error
        Set objFolderItem = objFolder.ParseName(fullfile)
        on error goto 0
        objFolderItem.InvokeVerbEx ("print")
    Next oAtt
    'Cleanup
    Set oFS = Nothing
    Set objFolder = Nothing
    Set objFolderItem = Nothing
    Set objShell = Nothing
    exit sub
OError:
    MsgBox Err.Number & " - " & Err.Description
    Err.Clear
    Exit Sub
OErrorDelay:
' Assuming the error is due to the file not yet being available
' Some method to delay the print request
' This will use the minimum delay, if it works
    i = i + 1
    ' some "reasonable" number
    if i > 100000 then goto OError
    resume
End Sub