Download Attachments from outlook

vmjan02

Well-known Member
Joined
Aug 15, 2012
Messages
531
I just want to give a path to download the attachments, but no success,

It is now a hell of the code. is always opening the browser folder which should not be the case. it should directly download the attachments in strPath.
"strPath" its not working,


Code



strPath = "E:\Performance Report Automation\Daily Reports"
Set objShell = CreateObject("Shell.Application")
Set objFSO = CreateObject("Scripting.FileSystemObject")

Set objFolder = objFSO.getfolder(strPath)


If Err.Number <> 0 Then
MsgBox "Run-time error '" & CStr(Err.Number) & " (0x" & CStr(Hex(Err.Number)) & ")':" & vbNewLine & _
Err.Description & ".", vbCritical, "Error from Attachment Saver"
blnIsEnd = True
GoTo PROC_EXIT
End If

If objFolder Is Nothing Then
strFolderPath = ""
blnIsEnd = True
GoTo PROC_EXIT
Else
strFolderPath = CGPath(objFolder.Self.Path)

' /* Go through each item in the selection. */
For Each objItem In selItems
lCountEachItem = objItem.Attachments.Count

' /* If the current item contains attachments. */
If lCountEachItem > 0 Then
Set atmts = objItem.Attachments

' /* Go through each attachment in the current item. */
For Each atmt In atmts

' Get the full name of the current attachment.
strAtmtFullName = atmt.FileName

' Find the dot postion in atmtFullName.
intDotPosition = InStrRev(strAtmtFullName, ".")

' Get the name.
strAtmtName(0) = Left$(strAtmtFullName, intDotPosition - 1)
' Get the file extension.
strAtmtName(1) = Right$(strAtmtFullName, Len(strAtmtFullName) - intDotPosition)
' Get the full saving path of the current attachment.
strAtmtPath = strFolderPath & atmt.FileName



' /* If the length of the saving path is not larger than 260 characters.*/
If Len(strAtmtPath) <= MAX_PATH Then
' True: This attachment can be saved.
blnIsSave = True

' /* Loop until getting the file name which does not exist in the folder. */
Do While objFSO.FileExists(strAtmtPath)
strAtmtNameTemp = strAtmtName(0) & _
Format(Now, "_mmddhhmmss") & _
Format(Timer * 1000 Mod 1000, "000")
strAtmtPath = strFolderPath & strAtmtNameTemp & "." & strAtmtName(1)

' /* If the length of the saving path is over 260 characters.*/
If Len(strAtmtPath) > MAX_PATH Then
lCountEachItem = lCountEachItem - 1
' False: This attachment cannot be saved.
blnIsSave = False
Exit Do
End If
Loop

' /* Save the current attachment if it is a valid file name. */
If blnIsSave Then atmt.SaveAsFile strAtmtPath
Else
lCountEachItem = lCountEachItem - 1
End If
Next
End If

' Count the number of attachments in all Outlook items.
lCountAllItems = lCountAllItems + lCountEachItem
Next
End If
 

Forum statistics

Threads
1,085,724
Messages
5,385,524
Members
401,957
Latest member
Socksnpants

Some videos you may like

This Week's Hot Topics

Top