When I run a VBA script to batch print PDFs from a specific MAPI folder in outlook, I get a "file not found" error inconsistently

Viewed 62

I made the code myself, and I am by no means someone with a lot of coding experience. I made loops that auto validate my files here to accommodate the different strength of machines at my current workplace. While these work fine a lot of the times, sometimes I get a "file not found" error pointing at my FileLen(NewFileName) on line 53. Which is weird because the file was referred to above this line. Could anyone help debug this?

here's the code:

Public Declare PtrSafe Sub Sleep Lib "kernel32" (ByVal Milliseconds As LongPtr)
Sub PrintAttachments()

'Section where I declare all the variables the code uses.
Dim olApp As Outlook.Application
Dim objNS As Outlook.NameSpace
Dim olFolder As Outlook.Folder
Dim RootFol As Outlook.Folder
Dim Item As Outlook.MailItem
Dim Items As Outlook.Items
Dim Att As Outlook.Attachment

Dim OldLen As Long
Dim NewLen As Long
Dim p As Object
Dim q As Object
Dim qLoop As Long
Dim TempFolder As Scripting.Folder
Dim FSO As Scripting.FileSystemObject
Dim TempDir As String
Dim NoSpace As String
Dim NewFileName As String
Dim Acrobat As String
Dim Qo As String
Qo = Chr(34)

'Set Outlook Objects in Variables to simplify code writing and understanding.
Set FSO = New Scripting.FileSystemObject
Set olApp = New Outlook.Application
Set objNS = olApp.GetNamespace("MAPI")
Set RootFol = objNS.GetDefaultFolder(olFolderInbox)
Set olFolder = RootFol.Folders("Print")
Set Items = olFolder.Items

'Set the location of a temp folder to store temporary PDF.
TempDir = Environ("LOCALAPPDATA") & "\TempPrint"
i = 1

'Check if the temp folder exists, if not, create it. If it exists, confirm its value to insert into future filename.
If FSO.FolderExists(TempDir) Then
    Set TempFolder = FSO.GetFolder(TempDir)
Else
    Set TempFolder = FSO.CreateFolder(TempDir)
End If

'Clean up the PDF used last time the macro was run.
Shell ("cmd /c Del /A /F /S /Q " & TempDir & "\*.*")

'Validate that the last command is done running before continuing.
While FSO.GetFolder(TempDir).Size > 0
    Sleep (50)
Wend

'Loop that searches in every mail in "Print" folder for .pdf type attachments.
For Each p In Items
    If p.Class = olMail Then
        Set Item = p
        If Item.Attachments.Count > 0 Then
            For Each Att In Item.Attachments
                If Att.FileName Like "*.pdf" Then
                    
                    'Replace every space (as string) found in the attachment name with "_", then write a new filename including
                    'the time and date of the mail's reception time to ensure a unique name for each attachment. Then save the file in the temporary folder path.
                    NoSpace = Replace(Att.FileName, " ", "_")
                    NewFileName = TempFolder.Path & "\" & Format(Item.ReceivedTime, "yyyy-mm-dd_hh-mm-ss_") & NoSpace
                    
                    'Save the file and validate it exists before continuing.
                    Att.SaveAsFile NewFileName
                    Do
                        If FSO.FileExists(NewFileName) Then
                            Exit Do
                        Else
                            DoEvents
                            Sleep (60)
                        End If
                    Loop
                    
                    'Loop to validate that the file has finished saving properly before sending a print request.
                    NewLen = 1
                    Do While NewLen > OldLen
                        Sleep (60)
                        OldLen = NewLen
                        NewLen = FileLen(NewFileName)
                        If NewLen < OldLen Then
                            NewLen = OldLen + 1
                        End If
                    Loop
                    OldLen = 0
                    
                    'Send a Print request through Adobe Acrobat Reader DC.
                    Acrobat = "cmd /c " & Qo & "C:\Program Files (x86)\Adobe\Acrobat Reader DC\Reader\AcroRd32.exe" & Qo & " /n /s /h /t "
                    Shell (Acrobat & NewFileName)
                End If
            Next Att
       End If
    End If
Next p

'Move every email back into the inbox
For qLong = Items.Count To 1 Step -1
    Set q = Items(qLong)
    If q.Class = olMail Then
        q.Move RootFol
    End If
Next qLong

End Sub
0 Answers
Related