Send report by email

[#1]

Hi,

I did a qvw report and I need to send it automatically by email,

how can I do it? or where can I find info about that?

Thanks,

David

[#2]

Hi, I have realised it but I have an other problem:

If I reload the model manually it works propperly but with the managment console it doesn't work do you know why??

here is the macro script

sub loopXL

    reportXL = getVariable("Attachement")

    set TableBox = ActiveDocument.GetSheetObject( "TB02" )

    ' let's start from data and miss headers

    for RowIter = 1 to TableBox.GetRowCount-1

        QVWName         = TableBox.GetCell(RowIter,0).Text

        QVWPath         = TableBox.GetCell(RowIter,1).Text

        ListOfObjects     = "CH53"'TableBox.GetCell(RowIter,2).Text

        QVWBookmark     = TableBox.GetCell(RowIter,3).Text

        UserName         = TableBox.GetCell(RowIter,4).Text

        UserPassword     = TableBox.GetCell(RowIter,5).Text

        EmailList         = TableBox.GetCell(RowIter,6).Text

        EmailSubj         = TableBox.GetCell(RowIter,7).Text

        EmailBody         = TableBox.GetCell(RowIter,8).Text

        ' call XL createion

        createXL QVWPath & QVWName, QVWBookmark, ListOfObjects, UserName, UserPassword, reportXL

        'send email

        sendMail EmailSubj,EmailBody,EmailList

    next

end sub

function getVariable(varName)

    set v = ActiveDocument.Variables(varName)

    getVariable = v.GetContent.String

end function

sub createXL(appName, appBook, ObjList, userName, userPassword, fileName)

    set App = ActiveDocument.GetApplication

    Rem ** open new document and activate it **

    set newdoc = App.OpenDoc(appName,userName,userPassword)

    if not isnull(appBook) then

        'apply bookmark

        newdoc.RecallDocBookmark appBook

    end if

    set XLApp = CreateObject("Excel.Application") ' Define Object

    set XLDoc = XLApp.Workbooks.Add 'Open new workbook

    createXLSheets newdoc, ObjList, XLDoc

    'Save the Excel

    XLApp.DisplayAlerts=False

    XLDoc.SaveAs fileName

    XLDoc.Close True

    XLApp.Quit

    Set XLDoc = Nothing

    Set XLApp = Nothing

    Rem ** back to ActiveDocument (= document running macro) **

    ActiveDocument.Activate 

    Rem ** close new document again **

    newdoc.CloseDoc

end sub

sub createXLSheets(newdoc, ObjList, XLDoc)

    set sheets = XLDoc.Sheets

    vLoop = true

    while vLoop

        startPos = inStr(ObjList, ",")

        if startPos = 0 then

            objName = ObjList

            vLoop = false

        else

            objName = left(ObjList, startPos - 1)

        end if

        if objName <> "" then

            'main block

            'msgbox(objName)

            ' add new sheet

            sheets.Add

            set obj = newdoc.GetSheetObject(objName)

            obj.CopyTableToClipboard true

            sheets(1).Paste

        '    sheets(1).Name = obj.GetCaption.Name.v

        end if

        ObjList = mid(ObjList, startPos + 1)

    wend

end sub

function sendMail(vSubj,vBody,vTo)

    Dim objEmail

    Const cdoSendUsingPort = 2     ' Send the message using SMTP

    Const cdoAnonymous = 0     'Do not authenticate

    Const cdoBasic = 1         'basic (clear-text) authentication

    Const cdoNTLM = 2         'NTLM

    SMTPServer = getVariable("SMTPServer")

    SMTPPort = getVariable("SMTPPort")               ' Port number for SMTP

    userName = getVariable("userName")

    userPassword = getVariable("userPassword")

    Const SMTPTimeout = 60              ' Timeout for SMTP in seconds

    'msgbox("get email object")

    'Sending mail

    Set objEmail = CreateObject("CDO.Message")

    Set objConf = objEmail.Configuration

    Set objFlds = objConf.Fields

    With objFlds

        '---------------------------------------------------------------------

           ' SMTP server details

           .Item("http://schemas.microsoft.com/cdo/configuration/sendusing") = cdoSendUsingPort

           .Item("http://schemas.microsoft.com/cdo/configuration/smtpserver") = SMTPServer

           .Item("http://schemas.microsoft.com/cdo/configuration/smtpauthenticate") = cdoAnonymous

'           .Item("http://schemas.microsoft.com/cdo/configuration/sendusername") = userName

'           .Item("http://schemas.microsoft.com/cdo/configuration/sendpassword") = userPassword

        .Item("http://schemas.microsoft.com/cdo/configuration/smtpserverport") = SMTPPort

        .Item("http://schemas.microsoft.com/cdo/configuration/smtpusessl") = False

          .Item("http://schemas.microsoft.com/cdo/configuration/smtpconnectiontimeout") = SMTPTimeout

           .Update

        '---------------------------------------------------------------------

    End With

    if isnull(vTo) then       

        objEmail.To = getVariable("EmailTo")                            'Email Recipient

    else

        objEmail.To = vTo                            'Email Recipient

    end if

    objEmail.From = getVariable("EmailFrom")                        'Email Sender

    if isnull(vSubj) then

        objEmail.Subject = getVariable("EmailSubject")                        ' Subject

    else

        objEmail.Subject = vSubj

    end if

    if isnull(vBody) then

        objEmail.TextBody = getVariable("EmailBody")        'Text Body 

    else

        objEmail.TextBody = vBody

    end if

    objEmail.AddAttachment   getVariable("Attachement")    ' Attachement

    'msgbox(SMTPServer & "; " &_

    '        SMTPPort & "; " &_

    '        userName & "; " &_

    '        userPassword & "; " &_

    '        cdoSendUsingPort & "; " &_

    '        cdoBasic & "; "_

    '        )

    'msgbox("config done, sending ...")

    objEmail.Send

    Set objFlds = Nothing

    Set objConf = Nothing

    Set objEmail = Nothing

    'msgbox ("Mail Sent")

end function

sub onOpenActivity

    ActiveDocument.DoReload 2,false,false

    loopXL

end sub

:

thanks