VBA Macro to email report as text

sdk development
1

Hi all,
with the help of various postings here on macros, I wrote a macro to email a report as text. Following is the code.

Sub Macro1()
    Dim ObjMessage As CDO.Message
    Dim doc As Document
    Set doc = ActiveDocument
    Dim docname, txtDocName, tempdoc As String
Dim i As Integer
Dim Rep As Report
        
    doc.Save
'tempdoc = doc.Name & Format(Now, "MM-DD-YYYY hh\hmm")
'doc.SaveAs (tempdoc)

'  txtDocName = Left(docname, (Len(docname) - 4)) + "_" + Format(Now, "MM-DD-YYYY hh\hmm") + ".txt"
   
  
 '   On Error Resume Next
For i = 1 To doc.Reports.Count
Set Rep = doc.Reports.Item(i)
Rep.ExportAsText ("C:\Reports\" & Rep.Name & Format(Now, "MM-DD-YYYY hh\hmm"))
Next i
On Error Resume Next
Call GeteMailInfo(doc)
Set ObjMessage = New CDO.Message

If Err.Number <> 0 Then WriteError (Now &amp; " " &amp; Err.Description)

ObjMessage.TextBody = email_textbody
ObjMessage.Subject = email_subject
ObjMessage.From = email_from
ObjMessage.To = email_to
On Error Resume Next
For i = 1 To doc.Reports.Count

ObjMessage.AddAttachment ("C:\Reports\" &amp; Rep.Name &amp; ".txt")

If Err.Number <> 0 Then
WriteError (Now &amp; " " &amp; Err.Description)
Else
WriteError (Now &amp; " " &amp; "C:\Reports\" &amp; Rep.Name &amp; ".txt" &amp; " Added")
End If

Next i

On Error Resume Next
ObjMessage.Send

If Err.Number <> 0 Then
WriteError (Now &amp; " " &amp; Err.Description)
Else
WriteError (Now &amp; " Message sent")
End If
On Error Resume Next

'Kill tempdoc

If Err.Number <> 0 Then
WriteError (Now &amp; " " &amp; Err.Description)
Else
WriteError (Now &amp; " " &amp; tempdoc &amp; " deleted")
End If

End Sub

Public Sub GeteMailInfo(myDoc)
    Dim MyVariable As busobj.DocumentVariable
    Dim loop_counter
    loop_counter = 1
    Do While loop_counter <= myDoc.DocumentVariables.Count
        Set MyVariable = myDoc.DocumentVariables.Item(loop_counter)
        Select Case MyVariable.Name
            Case "email_to"
                email_to = MyVariable.Formula
            Case "email_from"
                email_from = MyVariable.Formula
            Case "email_text"
                email_textbody = MyVariable.Formula
            Case "email_subject"
                email_subject = MyVariable.Formula
        End Select
        loop_counter = loop_counter + 1
    Loop
    On Error Resume Next
End Sub
Public Sub WriteError(Err_Description As String)
'The error_text.txt file where the messages and potential error
'message are going to be saved.
Open "C:\Reports\error_text.txt" For Append As #1
Print #1, Err_Description
Close #1
End Sub

I got the following errors in my error log file for three different runs on full client.

Also when I look for help (by pressing F1, to see the parameters b’cos the first error in log says -file specified is not found ) on the function AddAttachment it gives me the following error:

Has anybody come across these errors before?
Also Can someone tell me what does the 2nd statement in the error log mean?

Thanks in advance for your help.

[/quote]

SGuda (BOB member since 2004-04-17)

2

[moved to VBA forum - Nick]
Also, I posted it in BCA section, since I’m trying to schedule it in bca and I got the errors# 303.
I wasn’t sure if this should be in the Reporter section. Pl let me know.
Thnks.

SGuda (BOB member since 2004-04-17)

3

In the visual basic editor, I checked in the tools->references, and Microsoft CDO for exchange 2000 Library is checked. Also this macro works fine when report is saved and emailed in pdf format.

I’ve just recently started to write macros using VB and trying to find a solution for this. If anyone can throw some light on this, it will be a great help!

Thankyou.
Shan.

SGuda (BOB member since 2004-04-17)

4

At a minimum, you have to configure how / where you want to send. I don’t see where you’ve even specified the SMTP server to use. I would recommend searching BOB again for other code samples. This post is a place to start.

Dwayne Hoffpauir :us: (BOB member since 2002-09-19)