只要具有csv扩展名,有没有办法发送文件而不管其名称是什么?

时间:2019-05-08 12:30:32

标签: vba outlook outlook-vba

我将定期将csv文件发送到客户端。我想知道是否有一种方法可以发送文件夹中的任何文件,只要它具有csv扩展名,因为我不会提前知道文件名。

我相信我有可以使我的VBA脚本与任务计划程序结合使用的工作代码,以自动发送电子邮件。我只是停留在如何附加一个我不知道名字的文件上。

Const cSmtpUser = "username"                                ' *** MAKE CHANGES HERE ***
Const cSmtpPassword = "password"                            ' *** MAKE CHANGES HERE ***
Const cSmtpServer = "smtp.xxx.yyy"                          ' *** MAKE CHANGES HERE ***
Const cSmtpPort = 465                                       ' *** MAKE CHANGES HERE *** (25, 465, 587 common)
Const cFromEmail = "xxxxxxxxx@xxx.yyy"                      ' *** MAKE CHANGES HERE ***
Const cToEmail = "xxxxxxxxx@xxx.yyy"                        ' *** MAKE CHANGES HERE ***
Const cSubject = "Daily Email Subject"                      ' *** MAKE CHANGES HERE ***
Const cEmailBody = "See attached for todays file."          ' *** MAKE CHANGES HERE ***
Const cAttachment = "c:\temp\yourfile.txt"                  ' *** MAKE CHANGES HERE ***

' CDO Constants needed to send email
Const cCdoSendUsingPickup = 1   'Send message using the local SMTP service pickup directory.
Const cCdoSendUsingPort = 2     'Send the message using the network (SMTP over the network).
Const cCdoAnonymous = 0         'Do not authenticate
Const cCdoBasic = 1             'basic (clear-text) authentication
Const cCdoNTLM = 2              'NTLM
Const cCdoSendUsingMethod        = "http://schemas.microsoft.com/cdo/configuration/sendusing"
Const cCdoSMTPServer             = "http://schemas.microsoft.com/cdo/configuration/smtpserver"
Const cCdoSMTPServerPort         = "http://schemas.microsoft.com/cdo/configuration/smtpserverport"
Const cCdoSMTPConnectionTimeout  = "http://schemas.microsoft.com/cdo/configuration/smtpconnectiontimeout"
Const cCdoSMTPAuthenticate       = "http://schemas.microsoft.com/cdo/configuration/smtpauthenticate"
Const cCdoSendUserName           = "http://schemas.microsoft.com/cdo/configuration/sendusername"
Const cCdoSendPassword           = "http://schemas.microsoft.com/cdo/configuration/sendpassword"
Const cCdoSmtpUseSsl             = "http://schemas.microsoft.com/cdo/configuration/smtpusessl"

' Create filesystem object
Set objFSO = CreateObject("Scripting.FileSystemObject")

' Get a handle to the config object and it's fields
Set objConfig = CreateObject("CDO.Configuration")

' Set config fields we care about
With objConfig.Fields
    .Item(cCdoSendUsingMethod)       = cCdoSendUsingPort
    .Item(cCdoSMTPServer)            = cSmtpServer
    .Item(cCdoSMTPServerPort)        = cSmtpPort
    .Item(cCdoSMTPConnectionTimeout) = 60
    .Item(cCdoSMTPAuthenticate)      = cCdoBasic
    .Item(cCdoSendUserName)          = cSmtpUser
    .Item(cCdoSendPassword)          = cSmtpPassword
    .Item(cCdoSmtpUseSsl)            = True
    .Update
End With

' Create a new message
Set objMessage = CreateObject("CDO.Message")
Set objMessage.Configuration = objConfig

' Populate message fields and send it
With objMessage
    .To       = cToEmail
    .From     = cFromEmail
    .Subject  = cSubject
    .Textbody = cEmailBody
    If objFSO.FileExists(cAttachment) Then
        .AddAttachment cAttachment
    End If
    .Send
End With

希望只要文件夹具有csv扩展名,我就可以发送该文件夹中的任何文件。如果那是不可能的,但是不管扩展名如何,都可以发送任何文件,我可以这样做,以便文件夹中只有csv文件。

谢谢您的帮助。

1 个答案:

答案 0 :(得分:1)

您可以使用以下代码来发现所有扩展名为.csv的文件在特定文件夹中:

Dim oFile       As Object
Dim oFSO        As Object
Dim oFolder     As Object
Dim oFiles      As Object  

Set oFSO = CreateObject("Scripting.FileSystemObject")
Set oFolder = oFSO.GetFolder("C:\my\Folder\") 'Set this accordingly
Set oFiles = oFolder.Files

'For all files in the folder
For Each oFile In oFiles
    If (oFile Like "*.csv") Then
        'Add this file to attachments
        objMessage.AddAttachment oFile.Path
    End If
Next

希望这会有所帮助。