Unlock a world of possibilities! Login now and discover the exclusive benefits awaiting you.
Hi,
I have created a document reports. Now i want to send automail, but the issue for me is i want to send report as body of the mail.
My Macro is given below.
Sub Mail_Selection
SET AutoMail = ActiveDocument.Variables("vAutoMail")
if (AutoMail.GetContent.String = "1") then
Call exportToExcel_Variant2
ActiveDocument.Save
ActiveDocument.CloseDoc
else
end if
End Sub
'// ****************************************************************
'// Simple Export of just one object
'// More enhanced export of six objects to three different sheets
Sub exportToExcel_Variant2
'// Array for export definitions
Dim aryExport(1,3)
Set var26 = ActiveDocument.Variables("vFilePath")
aryExport(0,0) = "CH429"
aryExport(0,1) = "Test1"
aryExport(0,2) = "A1"
aryExport(0,3) = "data"
aryExport(1,0) = "CH431"
aryExport(1,1) = "Test1"
aryExport(1,2) = "A22"
aryExport(1,3) = "data"
Dim objExcelWorkbook 'as Excel.Workbook
Set objExcelWorkbook = copyObjectsToExcelSheet(ActiveDocument,aryExport)
Call objExcelWorkbook.SaveAs(var26.GetContent.String,51) '("E:\Export\Test.xlsx",51)
objExcelWorkbook.Application.Quit
Call SendMail
'// Now either just leave Excel open or do some other stuff here
'// like saving the excel, some formatting stuff, ...
end sub
Private Function copyObjectsToExcelSheet(qvDoc, aryExportDefinition) 'as Excel.Workbook
Dim i 'as Integer
Dim objExcelApp 'as Excel.Application
Dim objExcelDoc 'as Excel.Workbook
Set objExcelApp = CreateObject("Excel.Application")
objExcelApp.Visible =false 'false if you want to hide Excel
objExcelApp.DisplayAlerts = false
Set objExcelDoc = objExcelApp.Workbooks.Add
Dim strSourceObject
Dim qvObjectId 'as String
Dim sheetName
Dim sheetRange
Dim pasteMode
Dim objSource
Dim objCurrentSheet
Dim objExcelSheet
for i = 0 to UBOUND(aryExportDefinition)
'// Get the properties of the exportDefinition array
qvObjectId = aryExportDefinition(i,0)
sheetName = aryExportDefinition(i,1)
sheetRange = aryExportDefinition(i,2)
pasteMode = aryExportDefinition(i,3)
Set objExcelSheet = Excel_GetSheetByName(objExcelDoc, sheetName)
if (objExcelSheet is nothing) then
Set objExcelSheet = Excel_AddSheet(objExcelApp, sheetName)
msgbox("No sheet could be created, this should not occur!!!")
objExcelSheet.Select
set objSource = qvDoc.GetSheetObject(qvObjectId)
Call objSource.GetSheet().Activate()
objSource.Maximize
qvDoc.GetApplication.WaitForIdle
if (not objSource is nothing) then
if (pasteMode = "image") then
Call objSource.CopyBitmapToClipboard()
Call objSource.CopyTableToClipboard(true) '// default & fallback
Set objCurrentSheet = objExcelDoc.Sheets(sheetName)
objExcelDoc.Sheets(sheetName).Range(sheetRange).Select
objExcelDoc.Sheets(sheetName).Paste
if (pasteMode <> "image") then
With objExcelApp.Selection
.WrapText = False
.ShrinkToFit = False
End With
objCurrentSheet.Range("A1").Select
next
Call Excel_DeleteBlankSheets(objExcelDoc)
'// Finally select the first sheet
objExcelDoc.Sheets(1).Select
'// Return value
Set copyObjectsToExcelSheet = objExcelDoc
end function
'// ________________________________________________________________
'// Internal function for getting the Excel sheet by sheetName
Private Function Excel_GetSheetByName(ByRef objExcelDoc, sheetName) 'as Excel.Sheet
For Each ws In objExcelDoc.Worksheets
If (trim(ws.Name) = Excel_GetSafeSheetName(sheetName)) then
Set Excel_GetSheetByName = ws
exit function
End If
Next
'// default return value
Set Excel_GetSheetByName = nothing
End Function
Private Function Excel_GetSafeSheetName(sheetName)
'// can be max 31 characters long
retVal = trim(left(sheetName, 31))
Excel_GetSafeSheetName = retVal
'// Internal function for adding a new sheet
Private Function Excel_AddSheet(objExcelApplication, sheetName) ' as Excel.Sheet
'// add a sheet to the last position
objExcelApplication.Sheets.Add , objExcelApplication.Sheets(objExcelApplication.Sheets.Count)
Dim objNewSheet
Set objNewSheet = objExcelApplication.Sheets(objExcelApplication.Sheets.Count)
objNewSheet.Name = left(sheetName,31)
'// return the newly created sheet
Set Excel_AddSheet = objNewSheet
End function
'// Delete all empty sheets
Private Sub Excel_DeleteBlankSheets(ByRef objExcelDoc)
If (not HasOtherObjects(ws)) then
If objExcelDoc.Application.WorksheetFunction.CountA(ws.Cells) = 0 Then
On Error Resume Next
Call ws.Delete()
'// Helper function to determine if there are other objects placed
'// on the sheet ...
Public Function HasOtherObjects(ByRef objSheet) 'As Boolean
Dim c
If (objSheet.ChartObjects.Count > 0) Then
HasOtherObjects = true
Exit function
If (objSheet.Pictures.Count > 0) Then
If (objSheet.Shapes.Count > 0) Then
HasOtherObjects = false
'//__________________________________________________________________
Sub SendMail
Set myApp = CreateObject ("Outlook.Application")
Set myMessage = myApp.CreateItem(olMailItem)
myMessage.BodyFormat = 2 'Outlook.OlBodyFormat.olFormatRichText
'Supplier = ActiveDocument.Variables("SelectedSupplier").GetContent.String
myMessage.Subject = ActiveDocument.Variables("vSubject").GetContent.String ''"DSC Engineer Productivity Achievement and Penalty %age" 'Supplier & " / Maksukehotus"
'call GetPossibleValues ("E-mail 1","strTo",",")
strTo = ActiveDocument.Variables("ToEmails").GetContent.String
myMessage.To = strTo
StrCc = ActiveDocument.Variables("vCCEmail").GetContent.String
myMessage.Cc = StrCc
Set myInspector = myMessage.GetInspector 'this inserts signature to e-mail
Set myDoc = myInspector.WordEditor
myMessage.Attachments.Add var26.GetContent.String
ActiveDocument.GetSheetObject("TX498").CopyTextToClipboard
myText = ActiveDocument.GetSheetObject("TX498").GetText 'this is needed to calculate the lenght of the iserted text to put the next object after it
myDoc.Range(0,0).Paste 'This pastes at the begining of the message body
ActiveDocument.ActiveSheet("Document\RP02").CopyBitmaptoClipboard true
myDoc.Range(len(myText),len(myText)).Paste 'Pastes after the previous text 'myDoc.Range(10,10).Paste
' myDoc.Range(myDoc.Characters.Count-1, myDoc.Characters.Count).Paste 'Pastes at the end of the message body
' myMessage.GetInspector.WordEditor.Range.Paste 'Replaces the entire message body with clipboard content
' myInspector.WordEditor.Content.InsertAfter chr(13) 'inserts an empty string at the end of the message body content
myMessage.Display
myMessage.Send
Set myMessage = Nothing
Set myApp = Nothing
Set myInspector = Nothing
Set myDoc = Nothing
'Finally:
'OlSecurityManager.DisableOOMWarnings = False
Hi, could you put a qvw example please?
thank you
Fernando
I have created a static report with three different Excel Say Excel 1, Excel 2, Excel 3 and the report wil come in single sheet which is like PDF. Now i want the report which is PDF in Email Body Say Excel 1,2,3 in the single EMail Body.
My Report Name is RP02.
I want this report in EMail body.
