'Declarando as variaveis internas leitura dos arquivos
Dim arquivos
Set objFSO = CreateObject("Scripting.FileSystemObject")
'Setando pasta de origem
objStartFolder = "C:\TESTE\ORIGEM"
Set objFolder = objFSO.GetFolder(objStartFolder)
'Setando pasta de Destino
pastaDestino = "C:\TESTE\DESTINO"
'Listando todos os arquvios da pasta e contatenando em um unico nome para envio por e-mail
Set colFiles = objFolder.Files
For Each objFile in colFiles
If arquivos = "" Then
arquivos = objStartFolder & objFile.Name
Else
arquivos = arquivos & " | " & objStartFolder & objFile.Name
End If
arquivo = objStartFolder & objFile.Name
objFSO.CopyFile arquivo, pastaDestino
Next
'Envio por e-Mail vbScript
' Declarando as variaveis internas do envio por e-mail vbScript
Set emailObj = CreateObject("CDO.Message")
emailObj.From = "teste@teste.com"
emailObj.To = "teste@teste.com"
emailObj.Subject = "Testando"
emailObj.TextBody = "Teste "&Date()&" "&Time()
emailObj.AddAttachment arquivos
Set emailConfig = emailObj.Configuration
emailConfig.Fields("http://schemas.microsoft.com/cdo/configuration/smtpserver") = "smtp.gmail.com"
emailConfig.Fields("http://schemas.microsoft.com/cdo/configuration/smtpserverport") = 465
emailConfig.Fields("http://schemas.microsoft.com/cdo/configuration/sendusing") = 2
emailConfig.Fields("http://schemas.microsoft.com/cdo/configuration/smtpauthenticate") = 1
emailConfig.Fields("http://schemas.microsoft.com/cdo/configuration/smtpusessl") = true
emailConfig.Fields("http://schemas.microsoft.com/cdo/configuration/sendusername") = "teste@teste.com"
emailConfig.Fields("http://schemas.microsoft.com/cdo/configuration/sendpassword") = "password"
emailConfig.Fields.Update
emailObj.Send
If err.number = 0 then Msgbox "Done"
'Realizando historico de arquivos e deletando da pasta atual.
Const DeleteReadOnly = TRUE
For Each objFile in colFiles
arquivo = objStartFolder & objFile.Name
objFSO.DeleteFile(arquivo), DeleteReadOnly
Next