Hi I'm new to VBS and I'm trying to email some databases after they have been zipped but the file size to too large for the server. Is there an easier way? the databases are all in a file "Asoft32"
' Delete All Files in a Folder
Dim FSO, D, F,IV
Set FSO = CreateObject("Scripting.FileSystemObject")
Set D = FSO.GetFolder("C:\Asoft32zip")
For Each F In D.Files
FSO.DeleteFile F.path, True
Next
FSO = 0
Set FSO = CreateObject("Scripting.FileSystemObject")
Set D = FSO.GetFolder("C:\Asoft33zip\ZIP FILE")
For Each F In D.Files
FSO.DeleteFile F.path, True
next
WScript.Sleep 5000
'Copies >mdb files from Database to a zip
Set IV=CreateObject("Scripting.FilesystemObject")
On Error Resume Next
IV.CopyFile "C:\ASoft32\*.mdb", "C:\ASoft32zip\"
on error resume next
WScript.Sleep 10000
'Zips up .mdb files into a zip file
folder1 = "C:\Asoft32zip"
zipfile = "C:\Asoft33zip\ZIP FILE\JB Motors.zip"
Set objFSO = CreateObject("Scripting.FileSystemObject")
objFSO.OpenTextFile(zipfile, 2, True).Write "PK" & Chr(5) & Chr(6) _
& String(18, Chr(0))
Set ShellApp = CreateObject("Shell.Application")
Set zip = ShellApp.NameSpace(zipfile)
zip.CopyHere folder1
WScript.Sleep 10000
Dim file1, file2
file1 = "C:\Asoft33zip\ZIP FILE\JB Motors.zip"
file2 = "C:\Asoft33zip\ZIP FILE\JB Motors" &" "& Day(date) &"-"& month(date) & "-"& Year(Date) & ".zip"
Set fso = CreateObject("Scripting.FileSystemObject")
If fso.FileExists(file1) = true then
If fso.FileExists(file2) = true then
fso.DeleteFile(file2)
End if
fso.MoveFile file1, file2
End If
WScript.Sleep 20000
'Emails zip folder to iain@xxxxx.co.uk
Const schema = "Const cdoBasic = 1
Const cdoSendUsingPort = 2
Dim oMsg, oConf
' E-mail properties
Dim Today
Today = FormatDateTime(Date, 2)
Set oMsg = CreateObject("CDO.Message")
oMsg.From = "jbmoxxxxxxxx@gmail.com" ' or "Sender Name <from@gmail.com>"
oMsg.To = "iain@xxxxxxxx.co.uk" ' or "Recipient Name <to@gmail.com>"
oMsg.Subject = "JB Backup Files""-" & Date
oMsg.TextBody = "Backup Files have been Zipped up and emailed"
oMsg.AddAttachment "C:\Asoft33zip\ZIP FILE\JB Motors" &" "& Day(date) &"-"& month(date) & "-"& Year(Date) & ".zip"
Dim oFSO
Set oFSO=CreateObject("scripting.filesystemobject")
oFSO.CopyFile "C:\Asoft32zip\JB Motors.zip","C:\Asoft32zip\" & "JB Motors" & Replace(Date,"/","") & ".zip"
' GMail SMTP server configuration and authentication info
Set oConf = oMsg.Configuration
oConf.Fields(schema & "smtpserver") = "smtp.gmail.com" 'server address
oConf.Fields(schema & "smtpserverport") = 465 'port number
oConf.Fields(schema & "sendusing") = cdoSendUsingPort
oConf.Fields(schema & "smtpauthenticate") = cdoBasic 'authentication type
oConf.Fields(schema & "smtpusessl") = True 'use SSL encryption
oConf.Fields(schema & "sendusername") = "jbxxxxxx@gmail.com" 'sender username
oConf.Fields(schema & "sendpassword") = "xxxx" 'sender password
oConf.Fields.Update()
' send message
oMsg.Send()
' Return status message
If Err Then
resultMessage = "ERROR " & Err.Number & ": " & Err.Description
Err.Clear()
Else
' Display completion message for 6 seconds
Const TIMEOUT = 6
Set objShell = WScript.CreateObject("WScript.Shell")
objShell.Popup "Zip file Email sent" , TIMEOUT
End If
' Delete All Files in a Folder
Dim FSO, D, F,IV
Set FSO = CreateObject("Scripting.FileSystemObject")
Set D = FSO.GetFolder("C:\Asoft32zip")
For Each F In D.Files
FSO.DeleteFile F.path, True
Next
FSO = 0
Set FSO = CreateObject("Scripting.FileSystemObject")
Set D = FSO.GetFolder("C:\Asoft33zip\ZIP FILE")
For Each F In D.Files
FSO.DeleteFile F.path, True
next
WScript.Sleep 5000
'Copies >mdb files from Database to a zip
Set IV=CreateObject("Scripting.FilesystemObject")
On Error Resume Next
IV.CopyFile "C:\ASoft32\*.mdb", "C:\ASoft32zip\"
on error resume next
WScript.Sleep 10000
'Zips up .mdb files into a zip file
folder1 = "C:\Asoft32zip"
zipfile = "C:\Asoft33zip\ZIP FILE\JB Motors.zip"
Set objFSO = CreateObject("Scripting.FileSystemObject")
objFSO.OpenTextFile(zipfile, 2, True).Write "PK" & Chr(5) & Chr(6) _
& String(18, Chr(0))
Set ShellApp = CreateObject("Shell.Application")
Set zip = ShellApp.NameSpace(zipfile)
zip.CopyHere folder1
WScript.Sleep 10000
Dim file1, file2
file1 = "C:\Asoft33zip\ZIP FILE\JB Motors.zip"
file2 = "C:\Asoft33zip\ZIP FILE\JB Motors" &" "& Day(date) &"-"& month(date) & "-"& Year(Date) & ".zip"
Set fso = CreateObject("Scripting.FileSystemObject")
If fso.FileExists(file1) = true then
If fso.FileExists(file2) = true then
fso.DeleteFile(file2)
End if
fso.MoveFile file1, file2
End If
WScript.Sleep 20000
'Emails zip folder to iain@xxxxx.co.uk
Const schema = "Const cdoBasic = 1
Const cdoSendUsingPort = 2
Dim oMsg, oConf
' E-mail properties
Dim Today
Today = FormatDateTime(Date, 2)
Set oMsg = CreateObject("CDO.Message")
oMsg.From = "jbmoxxxxxxxx@gmail.com" ' or "Sender Name <from@gmail.com>"
oMsg.To = "iain@xxxxxxxx.co.uk" ' or "Recipient Name <to@gmail.com>"
oMsg.Subject = "JB Backup Files""-" & Date
oMsg.TextBody = "Backup Files have been Zipped up and emailed"
oMsg.AddAttachment "C:\Asoft33zip\ZIP FILE\JB Motors" &" "& Day(date) &"-"& month(date) & "-"& Year(Date) & ".zip"
Dim oFSO
Set oFSO=CreateObject("scripting.filesystemobject")
oFSO.CopyFile "C:\Asoft32zip\JB Motors.zip","C:\Asoft32zip\" & "JB Motors" & Replace(Date,"/","") & ".zip"
' GMail SMTP server configuration and authentication info
Set oConf = oMsg.Configuration
oConf.Fields(schema & "smtpserver") = "smtp.gmail.com" 'server address
oConf.Fields(schema & "smtpserverport") = 465 'port number
oConf.Fields(schema & "sendusing") = cdoSendUsingPort
oConf.Fields(schema & "smtpauthenticate") = cdoBasic 'authentication type
oConf.Fields(schema & "smtpusessl") = True 'use SSL encryption
oConf.Fields(schema & "sendusername") = "jbxxxxxx@gmail.com" 'sender username
oConf.Fields(schema & "sendpassword") = "xxxx" 'sender password
oConf.Fields.Update()
' send message
oMsg.Send()
' Return status message
If Err Then
resultMessage = "ERROR " & Err.Number & ": " & Err.Description
Err.Clear()
Else
' Display completion message for 6 seconds
Const TIMEOUT = 6
Set objShell = WScript.CreateObject("WScript.Shell")
objShell.Popup "Zip file Email sent" , TIMEOUT
End If