Outlook VB 脚本自动将附件保存到驱动器

Outlook VB 脚本自动将附件保存到驱动器

我在 Outlook 中创建了一条规则,该规则在主题行中查找某个文本字符串,然后将邮件移动到文件夹并执行下面的脚本。我希望它检查文件的扩展名,如果是“JPG”,则使用预定义的字符串作为文件名保存它。

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

脚本出现以下运行时错误

‘429’ ActiveX 组件无法创建对象。

这是
Set objfso = CreateObject("Scripting.FileSystemObject")代码中的这一行。

我认为我的声明有误?有人能给出建议吗?Windows 上的 Outlook 2016。

答案1

我自己还没有尝试过,但是你可以尝试使用吗If UCase(objAtt.Name) Like "*.JPG" Then?像这样:

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

如果您需要支持更多文件类型,您可以尝试这样的操作:

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

相关内容