Outlook deleting attachments - vba

Question

I was trying to get a macro to save attachments from multiple emails in Outlook all at once. I have only tinkered around in Word VBA with successful outcomes and this clearly was too much for a noob like myself.
I tried searching for an already-done macro and I found one on this page (Save attachments to a folder and rename them) and I copied the macro from the most useful answer into my Outlook VBA. Foolish me ran the macro on pretty much all the emails I wanted to do it on, and now the attachments are no longer there instead showing the message:
"C:\Users\fran1\Documents\Attachments\BATMAN_WEI2-1_3470_001.pdf"
for every file.
However, that folder does not exist, the link is broken and I cannot seem to manually find the equivalent folder. My question is, are the files stored somewhere in my computer? If so, how can I retrieve them? I have tried looking for them using their file name (which is pretty specific) but to no avail. These files are an automatic PDF generated from a scanner and so to get the files back I need to scan the documents again which takes some time, hence why I am keen on getting the attachment files back. Any answer on what the macro might have done with the files is very much welcome. Worst case scenario, I will have to spend another 90 minutes scanning the docs back.

Answer 1

While not an answer to recovering your files (although you can check the OLK folder as per comments), you may want a better functioning VBA script for saving future attachments; so the following is code to save (and safely remove if desired) attachments from selected e-mails.
Duplicated filenames will not be saved or removed from e-mails unless set to do so.
Update the FilePath to where you would like to save the files
Public Sub SaveAttachmentsFromSelectedEmails()
Dim olItem As Outlook.MailItem
Dim olSelection As Outlook.Selection: Set olSelection = ActiveExplorer.Selection
Dim FilePath As String: FilePath = Environ("USERPROFILE") & "\Documents\Documents\Attachments"
If Dir(FilePath, vbDirectory) = "" Then
Debug.Print "Save folder does not exist"
Exit Sub
End If
For Each olItem In olSelection
SaveAttachments olItem, FilePath, RemoveAttachments:=False
Next olItem
End Sub
Function SaveAttachments(ByVal Item As Object, FilePath As String, _
Optional FileExtensions As String = "*", _
Optional Delimiter As String = ",", _
Optional RemoveAttachments As Boolean = False, _
Optional OverwriteFiles As Boolean = False) As Boolean
On Error GoTo ExitFunction
Dim i As Long, j As Long, FileName As String, Flag As Boolean
Dim Extensions() As String: Extensions = Split(FileExtensions, Delimiter)
If Right(FilePath, 1) <> "\" Then FilePath = FilePath & "\"
For j = LBound(Extensions) To UBound(Extensions)
With Item.Attachments
If .Count > 0 Then
For i = .Count To 1 Step -1
FileName = FilePath & .Item(i).FileName
Flag = IIf(LCase(Right(FileName, Len(Extensions(j)))) = LCase(Extensions(j)), True, False)
Flag = IIf(FileExtensions = "*" Or Flag = True, True, False)
If Flag = True Then
If Dir(FileName) = "" Or OverwriteFiles = True Then
.Item(i).SaveAsFile FileName
Else
Debug.Print FileName & " already exists"
Flag = False
End If
End If
If RemoveAttachments = True And Dir(FileName) <> "" And Flag = True Then .Item(i).Delete
Next i
End If
End With
Next j
SaveAttachments = True
ExitFunction:
End Function