1

'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

0

Pesquise outras perguntas com a tag .