VBA в Outlook для сохранения .csv файлов, отправленных по указанным адресам - вызывается по правилу - PullRequest
Новая
       119

VBA в Outlook для сохранения .csv файлов, отправленных по указанным адресам - вызывается по правилу

0 голосов
/ 15 октября 2019

У меня возникли проблемы с работой работающего сценария VBA, который выполняет следующие действия при вызове правилом для применения к входящей почте.

  • Указывает, присутствует ли вложение .csv
  • Идентифицирует адрес электронной почты отправителя
  • Если адрес отправителя совпадает с X, а электронная почта содержит вложение .csv, сохраните файл в папке A
  • Если адрес отправителя совпадает с Y иэлектронная почта содержит вложение .csv, сохраните файл в папку B

Я нашел и настроил скрипт, который извлекает файлы CSV с определенных адресов в правиле, и он прекрасно работал, но теперь мне нужноиметь возможность сохранять вложения с разных адресов в разных папках.

Вот текущая перестановка моего скрипта (который не работает!): 

Public Sub saveAttachtoDisk(itm As Outlook.MailItem)

    Dim objAtt As Outlook.Attachment
    Dim fileType As String
    Dim dateFormat

    dateFormat = Format(Now, "yyyy-mm-dd H-mm-ss")
    fileType = ".csv"

    Dim sender As String
    sender = itm.SenderEmailAddress

    Dim fpX As String
    Dim fpY As String

    fpX = "C:\.test-X"
    fpY = "C:\.test-Y"

    For Each objAtt In itm.Attachments

        If InStr(objAtt.DisplayName, fileType) And sender = "senderX@test.co.uk" Then
            objAtt.SaveAsFile fpX & "\" & dateFormat & objAtt.DisplayName

        ElseIf InStr(objAtt.DisplayName, fileType) And sender = "senderY@test.co.uk" Then
            objAtt.SaveAsFile fpY & "\" & dateFormat & objAtt.DisplayName

        End If
        Set objAtt = Nothing

    Next

End Sub

Это не приводит к ошибкам компиляции- кажется, просто ничего не делать. В настоящее время он настроен на применение ко всей входящей почте в моем Outlook.

В интересах полной прозрачности я очень новичок в VBA и почти исключительно узнал из сценариев обратной разработки, которые я нашел в Интернете. Любая помощь по вышеуказанному будет принята с благодарностью.

- РЕДАКТИРОВАТЬ 1 -

Обновленный код, приведенный ниже - проходит через цикл For Each 3 раза и завершается без ошибок:

Public Sub saveAttachtoDisk(objMail As Outlook.MailItem)

Dim objAtt As Outlook.Attachment
Dim fileType As String
Dim dateFormat

dateFormat = Format(Now, "yyyy-mm-dd H-mm-ss")
fileType = ".csv"

Dim senderX As String
Dim senderY As String
senderX = "senderX@test.co.uk"
senderY = "senderY@test.co.uk"

Dim fpX As String
Dim fpY As String

fpX = "C:\.test-X"
fpY = "C:\.test-Y"

    For Each objAtt In objMail.Attachments

        If InStr(objAtt.DisplayName, fileType) And objMail.SenderEmailAddress = senderX Then
          objAtt.SaveAsFile fpX & "\" & dateFormat & objAtt.DisplayName

        ElseIf InStr(objAtt.DisplayName, fileType) And objMail.SenderEmailAddress = senderY Then
          objAtt.SaveAsFile fpY & "\" & dateFormat & objAtt.DisplayName

    End If
    Set objAtt = Nothing

    Next

End Sub

- РЕДАКТИРОВАТЬ 2 -

Благодаря Майку и Полу за их технические знания и советы по отладке, вы можете найти готовые и рабочиекод ниже! 

    Public Sub saveAttachtoDisk(objMail As Outlook.MailItem)

'--------------------------------------------------------- VARIBLE DECLARATION

    Dim objAtt As Outlook.Attachment
    Dim fileType As String
    Dim dateFormat
    Dim exUser As Outlook.ExchangeUser

    Dim exSender1 As String
    Dim exSender2 As String

    Dim filePath1 As String
    Dim filePath2 As String

'--------------------------------------------------------- VARIBLE DEFINITION

    Set exUser = objMail.sender.GetExchangeUser
    dateFormat = Format(Now, "yyyy-mm-dd H-mm-ss")
    fileType = ".csv"

    'The addresses outlined here are CaSe SeNsItIvE
    exSender1 = "SenderOne@test.co.uk"
    exSender2 = "SenderTwo@test.co.uk"

    filePath1 = "C:\SenderOneCSV"
    filePath2 = "C:\SenderTwoCSV"

'--------------------------------------------------------- IDENTIFY & SAVE LOOP

    For Each objAtt In objMail.Attachments

        If InStr(objAtt.DisplayName, fileType) And exUser.PrimarySmtpAddress = exSender1 Then
            objAtt.SaveAsFile filePath1 & "\" & dateFormat & objAtt.DisplayName

        ElseIf InStr(objAtt.DisplayName, fileType) And exUser.PrimarySmtpAddress = exSender2 Then
            objAtt.SaveAsFile filePath2 & "\" & dateFormat & objAtt.DisplayName

        End If
        Set objAtt = Nothing

    Next

End Sub
...