Question

我有一个代码可以从文件夹中选取最新的PDF并将其发送到指定的电子邮件地址（由回复我之前帖子的用户提供）。

它适用于单个文件夹和各种电子邮件规范，但我也希望它能够查看另一个文件夹，并且如果在另一个文件夹中找到了文件，则会有不同的邮件规范。

我的代码目前只是重新运行该进程并查看另一个文件夹（由于过度复杂和混乱的变量，这已经无效）。我知道你们中的很多人都会因为我的尝试而哭泣，因为它真的很糟糕，笨重而且质量普遍很差 - 目前它发送的所有文件都是用第一个消息规范处理的，而且最后一个处理，但第二个消息规范。

Option Explicit

Sub SendFiles()
    Dim objOutLook As Object
    Dim fso As Object
    Dim strFile As String
    Dim fsoFile
    Dim fsoFldr
    Dim dtNew As Date, sNew As String
    Dim newOutlookInstance As Boolean

Set fso = CreateObject("Scripting.FileSystemObject")

If GetOutlook(objOutLook, newOutlookInstance) Then

    strFile = "C:\temp\" 'path to folder
    Set fsoFldr = fso.GetFolder(strFile)
    dtNew = Now() - TimeValue("00:00:30") '30 seconds ago

    For Each fsoFile In fsoFldr.Files
        If fsoFile.DateCreated > dtNew Then
            sNew = fsoFile.Path
            With objOutLook.CreateItem(olMailItem)
                .To = "email@address.com"
                .Subject = "Example"
                .BodyFormat = olFormatPlain
                .Attachments.Add sNew
                .Importance = olImportanceHigh
                .Send
            End With
        End If
    Next
    If newOutlookInstance Then objOutLook.Quit '<--| quit Outlook if an already running instance of it hasn't been found
    Set objOutLook = Nothing

Else
    MsgBox "Sorry: couldn't get a valid Outlook instance running"
End If

Dim obj As Object
Dim usdFile As String
Dim aFile
Dim aFldr
Dim dNew As Date, tNew As String
Dim newInstance As Boolean

Set fso = CreateObject("Scripting.FileSystemObject")

If GetOutlook(obj, newInstance) Then

usdFile = "H:\Supply Chain - JAN17\Depannage & Kanban Requests (AB-   TG)\Unsatisfied Depannage\"
Set aFldr = fso.GetFolder(usdFile)
dNew = Now() - TimeValue("00:00:30")

For Each aFile In aFldr.Files
    If aFile.DateCreated > dNew Then
        tNew = aFile.Path
        With obj.CreateItem(olMailItem)
            .To = "email.address2@gmail.com"
            .Subject = "Kanban Request - LIMITED STOCK"
            .BodyFormat = olFormatPlain
            .Attachments.Add sNew
            .Importance = olImportanceHigh
            .Send
        End With
    End If
Next

If newInstance Then obj.Quit
Set obj = Nothing

 Else
    MsgBox "Sorry: couldn't get a valid Outlook instance running"
End If

End Sub





Function GetOutlook(objOutLook As Object, newOutlookInstance As Boolean) As     Boolean
Set objOutLook = GetObject(, "Outlook.Application")
If objOutLook Is Nothing Then
    Set objOutLook = New Outlook.Application
    newOutlookInstance = True
End If
GetOutlook = Not objOutLook Is Nothing
End Function

Answer 1

您可以重构代码并生成帮助 Sub，要求任务搜索已传递的文件夹并将电子邮件发送到已传递主题的传递地址：

Sub SendFilesFromFolder(objOutLook As Object, fso As Object, fldrName As String, emailAddress As String, subject As String, dtNew As Date)
    Dim fsoFile As File

    For Each fsoFile In fso.GetFolder(fldrName).Files
        If fsoFile.DateCreated > dtNew Then
            With objOutLook.CreateItem(olMailItem)
                .To = emailAddress
                .subject = subject
                .BodyFormat = olFormatPlain
                .Attachments.Add fsoFile.Path
                .Importance = olImportanceHigh
                .Send
            End With
        End If
    Next
End Sub

相应地，你的＆＃34;主要＆＃34;代码将成为：

Sub SendFiles()
    Dim objOutLook As Object
    Dim fso As Object
    Dim dtNew As Date
    Dim newOutlookInstance As Boolean


    If GetOutlook(objOutLook, newOutlookInstance) Then
        Set fso = CreateObject("Scripting.FileSystemObject")
        dtNew = Now() - TimeValue("00:00:30") '30 seconds ago

        SendFilesFromFolder objOutLook, _
                            fso, _
                            "C:\temp\", _
                            "email@address.com", _
                            "Example", _
                            dtNew

        SendFilesFromFolder objOutLook, _
                            fso, _
                            "H:\Supply Chain - JAN17\Depannage & Kanban Requests (AB-   TG)\Unsatisfied Depannage\", _
                            "email.address2@gmail.com", _
                            "Kanban Request - LIMITED STOCK", _
                            dtNew

        If newOutlookInstance Then objOutLook.Quit '<--| quit Outlook if an already running instance of it hasn't been found
        Set objOutLook = Nothing
        Set fso = Nothing

    Else
        MsgBox "Sorry: couldn't get a valid Outlook instance running"
    End If

End Sub

查看单独的文件夹，然后在附加文件位置指定消息详细信息

1 个答案: