Alguna idea? gracias!
Esta sección te permite ver todos los mensajes escritos por este usuario. Ten en cuenta que sólo puedes ver los mensajes escritos en zonas a las que tienes acceso en este momento.
Mostrar Mensajes Menú'// ****************************************************************
'// Enviador Mails Pegados Cuerpo
'// ****************************************************************
sub SendMail
if Time()>TimeValue("10:15:00") and Time()<TimeValue("21:30:00")Then
' Object creation
Set objMsg = CreateObject("CDO.Message")
Set msgConf = CreateObject("CDO.Configuration")
strDate = CDate(Date)
set cs = ActiveDocument.GetSheetObject("CH80")
cs.ExportHtml "C:\Directory\Pruebas\informe.html"
objMsg.CreateMHTMLBody "file://C:\Directory\Pruebas\informe.html"
' Server Configuration
msgConf.Fields.Item("http://schemas.microsoft.com/cdo/configuration/sendusing") = 2
msgConf.Fields.Item("http://schemas.microsoft.com/cdo/configuration/smtpserver") = "server***********"
msgConf.Fields.Item("http://schemas.microsoft.com/cdo/configuration/smtpserverport") = 25
msgConf.Fields.Item("http://schemas.microsoft.com/cdo/configuration/smtpauthenticate") = 1
msgConf.Fields.Item("http://schemas.microsoft.com/cdo/configuration/sendusername") = "mimai********l"
msgConf.Fields.Item("http://schemas.microsoft.com/cdo/configuration/sendpassword") = "pass******"
msgConf.Fields.Item("http://schemas.microsoft.com/cdo/configuration/smtpusessl") = 1
msgConf.Fields.Update
' Email
objMsg.To = "mmail***********"
objMsg.From = "mail**********.com"
objMsg.Subject = "Reporte " & Now()
objMsg.Sender = "Reportes"
Set objMsg.Configuration = msgConf
' Send
objMsg.Send
' Clear
Set objMsg = nothing
Set msgConf = nothing
end if
end sub
'****************FTP Upload
'Upload a file/folder to an FTP server
Set oShell = CreateObject("Shell.Application")
Set objFSO = CreateObject("Scripting.FileSystemObject")
MiMes=Month(Now)
strDate2=ucase(MonthName(MiMes))
strDate = Day(Date()) &"_"& ucase(MonthName(MiMes))
'Path to file or folder to upload
path = "C:\archivos\archivoftp_"&strDate&".csv"
FTPUpload1
Sub FTPUpload1
if Time()>TimeValue("04:00:00") and Time()<TimeValue("04:45:00")Then
MiMes=Month(Now)
strDate2=ucase(MonthName(MiMes))
strDate = Day(Date()) &"_"& ucase(MonthName(MiMes))
On Error Resume Next
'Copy Options: 16 = Yes to All
Const copyType = 16
'FTP Wait Time in ms
waitTime = 80000
FTPUser = "user"
FTPPass = "pass"
FTPHost = "ftphost"
FTPDir = "/archivos"
strFTP = "ftp://" & FTPUser & ":" & FTPPass & "@" & FTPHost & FTPDir
Set objFTP = oShell.NameSpace(strFTP)
'Make new folder on FTP site
'objFTP.NewFolder "FTP Backup"
'Upload single file
If objFSO.FileExists(path) Then
Set objFile = objFSO.getFile(path)
strParent = objFile.ParentFolder
Set objFolder = oShell.NameSpace(strParent)
Set objItem = objFolder.ParseName(objFile.Name)
Wscript.Echo "Uploading file " & objItem.Name & " to " & strFTP
objFTP.CopyHere objItem, copyType
End If
'Upload all files in folder
If objFSO.FolderExists(path) Then
'Code below can be used to upload entire folder
Set objFolder = oShell.NameSpace(path)
Wscript.Echo "Uploading folder " & path & " to " & strFTP
objFTP.CopyHere objFolder.Items, copyType
End If
If Err.Number <> 0 Then
Wscript.Echo "Error: " & Err.Description
End If
'Wait for upload
WScript.Sleep waitTime
End if
End Sub