Tek-Tips is the largest IT community on the Internet today!

Members share and learn making Tek-Tips Forums the best source of peer-reviewed technical information on the Internet!

  • Congratulations strongm on being selected by the Tek-Tips community for having the most helpful posts in the forums last week. Way to Go!

Emailing a zipped file

Status
Not open for further replies.

i_malc

Technical User
Apr 19, 2017
3
ES
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
 
How big is the attachment?

Some email systems do not like password protected zip files because they want to look for viruses etc inside the zip file. If you want to password protect it, give it a non-zip extension: something like .zeep then tell the guy at the other end to rename it back to zip for unzipping.
 
The attachment is 53mb When I try and send an email and the file as an attachment in outlook it comes up with "The file you are attaching is bigger than the server allows. I had the script working with only copying one .mdb file over and it works
 
Well, that error message clearly tells you that the attachment is too large, so you're not having a vbscript problem. Not sure what help you want. Few if any mail servers are going to allow a 50+ megabyte attachment.

> I had the script working with only copying one .mdb file over and it works
So, send multiple emails each with a single .mdb file?
 
You could find out what the max size of attachments is and break it up into those sizes or dump them on an FTP site and tell the recipient to pick them up from there within a month otherwise they get deleted.

If you are emailing several addresses, the FTP method is preferred.
 
Status
Not open for further replies.

Part and Inventory Search

Sponsor

Back
Top