0

How to automatically download attachment that is an outlook item?

imag here

I tried downloading using this vba script but it does not work for outlook item. It works for .txt or any other type of attachment.

Public Sub Savisk(MItem As Outlook.MailItem)
Dim oAttachment As Outlook.Attachment
Dim sSaveFolder As String
sSaveFolder = "D:\userdata\sanakkay\Desktop\"
For Each oAttachment In MItem.Attachments
oAttachment.SaveAsFile sSaveFolder & oAttachment.DisplayName
Next
End Sub
Community
  • 1
  • 1
Ashish s
  • 33
  • 7
  • That does not look like `vb.net`... well some of it is mixed with `vb6`. Can you describe what `it doesn't work for outlook item`? – Trevor Oct 11 '17 at 19:51
  • sry.......... its not vb.net its vba code. this code works for attachments which are in .txt or .excel or other formats but doesnt work for file type outlook . view image for how outlook format looks like – Ashish s Oct 11 '17 at 19:55

2 Answers2

1

Outlook items may be named / have subjects with characters that are illegal in file names.

For example the colon character in

Task Name:KM_CEM_GY

There are at least two standard methods to address this.

Outlook 2010 VBA How to save message including attachment

Private Sub ReplaceCharsForFileName(sName As String, sChr As String)
    sName = Replace(sName, "'", sChr)
    sName = Replace(sName, "*", sChr)
    sName = Replace(sName, "/", sChr)
    sName = Replace(sName, "\", sChr)
    sName = Replace(sName, ":", sChr)
    sName = Replace(sName, "?", sChr)
    sName = Replace(sName, Chr(34), sChr)
    sName = Replace(sName, "<", sChr)
    sName = Replace(sName, ">", sChr)
    sName = Replace(sName, "|", sChr)
End Sub

VBA dialog boxes automatically answer solution

Function StripIllegalChar(StrInput)
    Dim RegX            As Object

    Set RegX = CreateObject("vbscript.regexp")

    RegX.Pattern = "[\" & Chr(34) & "\!\@\#\$\%\^\&\*\(\)\=\+\|\[\]\{\}\`\'\;\:\<\>\?\/\,]"
    RegX.IgnoreCase = True
    RegX.Global = True

    StripIllegalChar = RegX.Replace(StrInput, "")

ExitFunction:
    Set RegX = Nothing

End Function
niton
  • 8,771
  • 21
  • 32
  • 52
-1

If you want to download attachment from Outlook, try this. Private Sub GetAttachments()

Dim ns As Namespace
Dim Inbox As Outlook.MAPIFolder
Dim Item As Object
Dim Atmt As Outlook.Attachment
Dim FileName As String

Set ns = GetNamespace("MAPI")
Set Inbox = ns.Folders("MailboxName").Folders("Inbox")

If Inbox.Items.Count = 0 Then
    MsgBox "There are no messages in the Inbox.", vbInformation, _
            "Nothing Found"
    Exit Sub
End If

For Each Item In Inbox.Items
    For Each Atmt In Item.Attachments
        If Atmt.Type = 1 And InStr(Atmt, "xlsx") > 0 Then
            FileName = "C:\attachments\" & Atmt.FileName
            Atmt.SaveAsFile FileName
        End If
    Next Atmt
Next Item

End Sub Set a reference to MS Outlook and remember, the "MailboxName" is your email address.

ASH
  • 20,759
  • 19
  • 87
  • 200