Hi All,

I found a macro online which I’m trying to use to save the email to a folder within a specified directory. The folders are numbers either 4 or 5 digits like 5100 for example.

The macro isn’t finding the destination folder, even when I’ve changed it to c:\test and created a folder etc and tried different network directories.

Any ideas?

Private Function File_Exists(ByVal sPathName As String, Optional Directory As Boolean) As Boolean

'Returns True if the passed sPathName exist
'Otherwise returns False
On Error Resume Next
If sPathName <> "" Then

If IsMissing(Directory) Or Directory = False Then

File_Exists = (Dir$(sPathName) <> "")
Else

File_Exists = (Dir$(sPathName, vbDirectory) <> "")
End If

End If
End Function

Sub SaveAsMSG()
Dim myItem As Outlook.Inspector
Dim objItem As Object
PathName = "\\myserver\folder\"
Set myOlApp = CreateObject("Outlook.Application")
Set myItem = myOlApp.ActiveInspector
If Not TypeName(myItem) = "Nothing" Then
Set objItem = myItem.CurrentItem
StrSub = objItem.Subject
StrName = InputBox("Folder number...")
Do While File_Exists(PathName & StrName & "\Emails\", True) = False
StrName = InputBox("Folder does not exist, give a new number...", "new folder number")
Loop
Do While File_Exists(PathName & StrName & "\Emails\" & StrSub & ".msg") = True
StrSub = InputBox("File exists, give a new file name...", "new file name", StrSub)
Loop
objItem.SaveAs PathName & StrName & "\Emails\" & StrSub & ".msg", olMSG
Else
MsgBox "There is no current opened email item."
End If
End Sub