Saving to Desktop then Email Code

S

scott04

Hi everyone,
I am having a problem with one of my databases. I posted previously that
when i was using code to sendobject from a query in excel format i was
receiving the error back from my info security :virus detected
(CVE-2006-1309) Action: quarantine. After some thinking some of the fields
it dumped into excel were memo maybe that caused the problem? The code i was
using was:
Private Sub Command52_Click()
On Error GoTo Err_Save_Record_Click
DoCmd.SendObject acSendQuery, "Data Range Query for Email", , _
, , , "Review Request", "Attached are the results of your Review Requests",
Email
Exit_Save_Record_Click:
Exit Sub
Err_Save_Record_Click:
If Err.Number = 2101 Or 3021 Then
Resume Next
Else
MsgBox "Error " & Err.Number & " (" & Err.Description & ") " & _
"in Command52"
Resume Exit_Save_Record_Click
End If
Because i received that virus message i was forced to look for an
alternative. I have some code that saves the excel to my desktop since i
noticed that if i have a saved copy i can email to outside domain. The
problem is can i use the send object or some other command to ask for the
spreadsheet dv.xls that is on my desktop??? Here is the code i have thus
far.

Private Sub Command51_Click()
On Error GoTo ProcError
Dim strPath As String
strPath = CurrentProject.Path
DoCmd.OutputTo acOutputQuery, "Data Range Query for Email", acFormatXLS, _
strPath & "\DV.xls" ', AutoStart:=-1
MsgBox "The selected review requests have been exported to the " _
& "file DV.xls" & vbCrLf & "in the folder:" _
& vbCrLf & strPath, vbInformation, "Export Complete..."
ExitProc:
Exit Sub
ProcError:
MsgBox "Error " & Err.Number & ": " & Err.Description, , _
"Error in cmdExportToExcel_Click event procedure..."
Resume ExitPro
Any help is appreciated. I know I can try and use some automated code with
outlook but that code is still a little too complex for me as I am relatively
new and learning everyday more code. Thank you.
 
S

scott04

Found a solution:
On Error GoTo ProcError
Dim strPath As String
Dim rst As DAO.Recordset
Dim AppOutLook As Outlook.Application
Dim MailOutLook As Outlook.MailItem
Set AppOutLook = CreateObject("Outlook.Application")
Set MailOutLook = AppOutLook.CreateItem(olMailItem)
Dim EContent As String
Dim stDocName As String
strPath = CurrentProject.Path
DoCmd.OutputTo acOutputQuery, "Data Range Query for Email", acFormatXLS, _
"C: DV.xls" ', AutoStart:=-1
MsgBox "The selected review requests have been exported to your C drive " _
& "file DV.xls" & vbCrLf & "in the folder:" _
& vbCrLf, vbInformation, "Export Complete..."
With MailOutLook
..To = "email address @.com"
..Subject = "This is the name of your subject"
..Importance = olImportanceHigh
..Attachments.Add "C:\ DV.xls"
..DeleteAfterSubmit = True 'This Will delete it the bin.
..VotingOptions = "Completed"
..Save
..Send
End With
ExitProc:
Exit Sub
ProcError:
MsgBox "Error " & Err.Number & ": " & Err.Description, , _
"Error in cmdExportToExcel_Click event procedure..."
Resume ExitProc
End Sub
 

Ask a Question

Want to reply to this thread or ask your own question?

You'll need to choose a username for the site, which only take a couple of moments. After that, you can post your question and our members will help you out.

Ask a Question

Similar Threads

Send Outlook Code 1
No DLookUp 14
Move Files after import 1
proper code placement 4
me.visible doesn't work 3
Create dir based on record ID 1
Outlook events stop work randomly 0
Help !! VBA code to copy 2

Top