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

时间:2015-03-25 13:01:15

标签: vba outlook outlook-vba

我有以下代码,可在收到电子邮件时自动打印我的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

1 个答案:

答案 0 :(得分:-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