Welcome to OGeek Q&A Community for programmer and developer-Open, Learning and Share
Welcome To Ask or Share your Answers For Others

Categories

0 votes
1.3k views
in Technique[技术] by (71.8m points)

vba - How to exclude certain documents from macro that sends e-mails?

We have a macro that sends e-mails of documents in a certain directory. We want to exclude documents whose file names begin with "AUT_XXXXXX" ETA: the Xs can be a string of letters and numbers that vary.

Below is the macro we currently use:

Sub SendScannedDocstoWellsFargo()
Dim Filename As Variant
Dim olApp As Outlook.Application
Dim olNewEmail As Outlook.MailItem
Dim strDirectory As String
Dim strPath As String
Dim FSO As FileSystemObject
    
Set FSO = CreateObject("Scripting.FileSystemObject")
    
    Set olApp = Outlook.Application
    Filename = Dir("\kwa-file01ClientFilesWells Fargo III\_Scanned_DocumentsPending Uploads")
    
    strDirectory = "\kwa-file01ClientFilesWells Fargo III\_Scanned_DocumentsPending Uploads"
    
    
    While Filename <> ""
        'Comment out when completed
        'Debug.Print Filename
        'Set the filename to the next file
        Filename = Dir
        'Create a path for the item
        strPath = strDirectory & Filename
        If strPath = strDirectory Then GoTo StopThisNow
        
        'Create a mail item
        Set olNewEmail = olApp.CreateItem(olMailItem)
        With olNewEmail
            .To = "ccslegaldocuments@wellsfargo.com"
            .Subject = Filename
            .Attachments.Add (strPath)
            .Send
        End With
        
        FSO.DeleteFile strPath, True
        
        Set olNewEmail = Nothing
StopThisNow:
    Wend
    
    Set olApp = Nothing
    Set olNewEmail = Nothing
    strDirectory = ""
    Filename = ""
    strPath = ""
End Sub

I've seen other posts showing how to exclude certain file types, but these files are all PDFs.


与恶龙缠斗过久,自身亦成为恶龙;凝视深渊过久,深渊将回以凝视…
Welcome To Ask or Share your Answers For Others

1 Reply

0 votes
by (71.8m points)

Give this a try.

Read the code's comments and adjust it to fit your needs.

EDIT: Changed to Like statement with wildcards

Public Sub SendScannedDocstoWellsFargo()
    
    ' Define the folder path
    Dim folderPath As String
    folderPath = "C:Temp" ' "\kwa-file01ClientFilesWells Fargo III\_Scanned_DocumentsPending Uploads"
    
    ' Define the file name string to exclude
    Dim stringExclude As String
    stringExclude = "AUT_??????"
    
    ' Set a referece to the FSO object
    Dim FSO As FileSystemObject
    Set FSO = CreateObject("Scripting.FileSystemObject")
    
    ' Set a reference to Outlook application
    Dim outlookApp As Outlook.Application
    Set outlookApp = Outlook.Application
    
    ' Get files in folder
    Dim fileName As String
    fileName = Dir(folderPath)
    
    ' Loop through files
    Do While fileName <> ""
    
        If Not Left(fileName, Len(stringExclude)) Like stringExclude Then
            
            ' Build the file path
            Dim filePath As String
            filePath = folderPath & fileName
            
            ' Send the email by calling a procedure
            sendEmail outlookApp, filePath, fileName
            
            ' Delete the file
            FSO.DeleteFile filePath, True
        
        End If
        
        ' Call next file
        fileName = Dir
    
    Loop
    
    ' Clean up outlook reference
    Set outlookApp = Nothing

End Sub

Private Sub sendEmail(ByVal outlookApp As Outlook.Application, ByVal filePath As String, ByVal fileName As String)

    Dim olNewEmail As Outlook.MailItem
    
    'Create a mail item
    Set olNewEmail = outlookApp.CreateItem(olMailItem)
    With olNewEmail
        .To = "ccslegaldocuments@wellsfargo.com"
        .Subject = fileName
        .Attachments.Add filePath
        .Send
    End With
    
    Set olNewEmail = Nothing
    
End Sub

Let me know if it works


与恶龙缠斗过久,自身亦成为恶龙;凝视深渊过久,深渊将回以凝视…
OGeek|极客中国-欢迎来到极客的世界,一个免费开放的程序员编程交流平台!开放,进步,分享!让技术改变生活,让极客改变未来! Welcome to OGeek Q&A Community for programmer and developer-Open, Learning and Share
Click Here to Ask a Question

...