Advertisement
Advertisement
| 08.18.2008 at 09:45PM PDT, ID: 23658542 |
|
[x]
Attachment Details
|
||
|
[x]
The Solution Rating System
|
||
With so many solutions, how can you tell which solutions are most likely to help you and which ones are not? To provide you with a tool to use, we rate our solutions based on various elements that most accurately determine if a solution is a quality solution. To explain what factors affect the solution rating, here are the elements we take into consideration when formulating our solution rating.
Your Input Matters If you have any suggestions that you would like to make for our rating system, please ask a question in the Suggestions Zone of Community Support. Thank you! |
||
1: 2: 3: 4: 5: 6: 7: 8: 9: 10: 11: 12: 13: 14: 15: 16: 17: 18: 19: 20: 21: 22: 23: 24: 25: 26: 27: 28: 29: 30: 31: 32: 33: 34: 35: 36: 37: 38: 39: 40: 41: 42: 43: 44: 45: 46: 47: 48: 49: 50: 51: 52: 53: 54: 55: 56: 57: 58: 59: 60: 61: 62: 63: 64: 65: |
Sub Zip_Encrypt_Mail_DB(sDBName As String)
Dim sDate As String, DefPath As String, sBody As String
Dim oApp As Object, OutApp As Object, OutMail As Object
Dim sFileNameZip As String, sFileNameMDB As String
'Dim FileExtStr As String
DefPath = "C:\"
If Right(DefPath, 1) <> "\" Then
DefPath = DefPath & "\"
End If
'Create date/time string
sDate = Format(Now, " yyyymmdd hmmss")
sFileNameZip = DefPath & "MyData" & strDate & ".zip"
sFileNameMDB = DefPath & sDBName '"MyData.mdb"
If Dir(sFileNameZip) = "" Then
'Create empty Zip File
NewZip (sFileNameZip)
'Copy the file in the compressed folder
Set oApp = CreateObject("Shell.Application")
oApp.Namespace(sFileNameZip).CopyHere sFileNameMDB <---------------- Problem here!
'Keep script waiting until Compressing is done
On Error Resume Next
Do Until oApp.Namespace(sFileNameZip).items.Count = 1
DoEvents
Loop
On Error GoTo 0
'Create the mail
Set OutApp = CreateObject("Outlook.Application")
Set OutMail = OutApp.CreateItem(0)
strbody = "Hi there" & vbNewLine & vbNewLine & _
"This is line 1" & vbNewLine & _
"This is line 2" & vbNewLine & _
"This is line 3" & vbNewLine & _
"This is line 4"
On Error Resume Next
With OutMail
.To = "deedub84@gmail.com"
.CC = ""
.BCC = ""
.Subject = "This is the Subject line"
.Body = strbody
.Attachments.Add FileNameZip
.Display 'or use .Send
End With
On Error GoTo 0
'Delete the temporary Excel file and Zip file you send
Kill FileNameZip
Kill FileNameXls
Else
MsgBox "FileNameZip or/and FileNameXls exist"
End If
End Sub
|