Script do Outlook VB para autosave anexos ao drive

Question

Eu criei uma regra no outlook que procura por uma certa string de texto na linha de assunto, depois move a mensagem para uma pasta e executa o script abaixo. Eu quero que isso verifique a extensão do arquivo se "JPG", em seguida, salve-o com uma seqüência pré-definida como o nome do arquivo.

Public Sub saveAttachtoDisk_1(itm As Outlook.MailItem)
    Dim objAtt As Outlook.Attachment
    Dim saveFolder As String
    Dim dateFormat
    Dim FiledasName As String
    Dim objattext As String
    Dim objfso As Object

    dateFormat = Format(Now, "yyyy-mm-dd H-mm")
    saveFolder = "C:\Users\reeddl\Documents\Expenses_Image_Filing"

    Set objfso = CreateObject("Scripting.FileSystemObject")
    sExt = objfso.GetExtensionName(objAtt.FileName)

    For Each objAtt In itm.Attachments
        FiledasName = itm.Subject
        Set fso = New FileSystemObject
        If UCase(objfso.GetExtensionName(objAtt.Name)) = "JPG" Then
            MsgBox (objfso.GetExtensionName(objAtt.Name))
            objAtt.SaveAsFile saveFolder & "\" & dateFormat & FiledasName
        End If
        Set objAtt = Nothing
    Next
End Sub

Os erros de script com o seguinte erro de tempo de execução

'429' ActiveX component can't create object.

Isso está na linha Set objfso = CreateObject("Scripting.FileSystemObject") do código.

Eu acho que estou declarando isso incorretamente? Alguém pode aconselhar? Outlook 2016 no Windows.

    

Answer 1

Eu não tentei eu mesmo, mas você pode tentar usar If UCase(objAtt.Name) Like "*.JPG" Then ? Assim:

Public Sub saveAttachtoDisk_1(itm As Outlook.MailItem)
    Dim objAtt As Outlook.Attachment
    Dim saveFolder As String
    Dim dateFormat
    Dim FiledasName As String

    dateFormat = Format(Now, "yyyy-mm-dd H-mm")
    saveFolder = "C:\Users\reeddl\Documents\Expenses_Image_Filing"

    For Each objAtt In itm.Attachments
        FiledasName = itm.Subject
        Set fso = New FileSystemObject
        If UCase(objAtt.Name) Like "*.JPG" Then
            objAtt.SaveAsFile saveFolder & "\" & dateFormat & FiledasName
        End If
        Set objAtt = Nothing
    Next
End Sub

Se você precisar dar suporte a mais tipos de arquivos, tente algo assim:

Select Case UCase(Right(objAtt.Name, 3))
    Case "JPG", "PNG", "BMP", "GIF"
    objAtt.SaveAsFile saveFolder & "\" & dateFormat & FiledasName
End Select