I
ithappens
I need a reservation program to trigger a word reciept doc. I don't know
where to look. Where is this type of action listed or is.
where to look. Where is this type of action listed or is.
C
Cindy M -WordMVP-
Hi =?Utf-8?B?aXRoYXBwZW5z?=,
interface? Are you a programmer who knows how to use it?
If yes, how does that programming language deal with calling COM OLE-Server
applications? In the VB-languages, for example, we can use the NEW keyword
or CreateObject method to start and application and interface with it.
Cindy Meister
INTER-Solutions, Switzerland
http://homepage.swissonline.ch/cindymeister (last update Jun 8 2004)
http://www.word.mvps.org
This reply is posted in the Newsgroup; please post any follow question or
reply in the newsgroup and not by e-mail
You need to start with the reservation program. Does it have a programming
interface? Are you a programmer who knows how to use it?
If yes, how does that programming language deal with calling COM OLE-Server
applications? In the VB-languages, for example, we can use the NEW keyword
or CreateObject method to start and application and interface with it.
Cindy Meister
INTER-Solutions, Switzerland
http://homepage.swissonline.ch/cindymeister (last update Jun 8 2004)
http://www.word.mvps.org
This reply is posted in the Newsgroup; please post any follow question or
reply in the newsgroup and not by e-mail
I
ithappens
I know very very little on programming . Is visual basic where I should start
reading?
reading?
J
james.igoe
You would need to read material on office automation using VBA; I
believe VB might be too much for what you need. I've pasted code which
calls two functions, one to create a spreadsheet, and one to attach the
XLS, by using CreatObject:
Option Compare Database
Option Explicit
Function fxCreateSpreadsheetCreateMail(strQueries As String, strBRPPlan
As
String, strSubject As String) As Boolean
Dim strFileName As String
Dim bResponse As Boolean
'generate spreadsheet
strFileName = fxGenerateTabbedExcelFromReports(strQueries, strBRPPlan)
'open outlook oand send spreadsheet
bResponse = fxCreateOutlookEmail(strFileName, strSubject)
Exit Function
End Function
Function fxCreateOutlookEmail(strAttachmentName As String, strSubject
As
String) As Boolean
Dim objOutlookApp As New Outlook.Application
Dim objOutlookMail As Outlook.MailItem
Dim objOutlookAttachments As Outlook.Attachments
On Error GoTo ErrorTrap
Set objOutlookApp = CreateObject("Outlook.Application")
Set objOutlookMail = objOutlookApp.CreateItem(olMailItem)
With objOutlookMail
.Subject = strSubject
.Body = vbCrLf & vbCrLf & strAttachmentName & vbCrLf & vbCrLf
.Attachments.Add strAttachmentName, olByValue, 500
End With
objOutlookMail.Display
fxCreateOutlookEmail = True
Exit Function
ErrorTrap:
'releases resources from outlook and associated components
If Not objOutlookApp Is Nothing Then
objOutlookApp.Quit
If Not objOutlookMail Is Nothing Then
Set objOutlookMail = Nothing
End If
If Not objOutlookAttachments Is Nothing Then
Set objOutlookAttachments = Nothing
End If
Set objOutlookApp = Nothing
End If
'returns false in case of error to calling module
fxCreateOutlookEmail = False
End Function
Function fxGenerateTabbedExcelFromReports(strReports As Variant,
strBRPPlan As
String) As String
Dim objExcelApplication As New Excel.Application
Dim objExcelWorkbook As Excel.Workbook
Dim objExcelWorksheet As Excel.Worksheet
'File Ralted variables
Dim strFileName As String
Dim strDate As String
Dim arrReports As Variant
Dim strCurrentDIR As String
Dim temp As Variant
Dim dbCurrent As DAO.Database
Dim rsCurrent As DAO.Recordset
Set dbCurrent = CurrentDb
'SQL String and replacement
Dim strSQLName As String
Dim strSQL As String
Dim strCombo As String
'Variables to manipulate recordset
Dim dblWorksheet As Double
Dim dblRow As Double
Dim dblColumn As Double
On Error GoTo ErrorTrap
'Variable for message boxes
Dim Response As Long
'creates date string for use in file name
strDate = Format(Date, "yyyy-mm-dd")
'replace with dynamic path
'creates file name string
strCurrentDIR = Application.CurrentProject.Path
strFileName = strCurrentDIR & "\" & "rptFoBo_" & Replace(strBRPPlan, "
", "")
& "_" & strDate & ".xls"
'creates array of report names, used in naming tabs and creating
recordsets to
populate Excel
arrReports = Split(strReports, ";")
'creates Excel Workbook
Set objExcelApplication = CreateObject("Excel.Application")
Set objExcelWorkbook = objExcelApplication.Workbooks.Add
'Removed most of the execution code
' for legibility
'Quits Excel and resets variables to Nothing
objExcelApplication.Quit
Set objExcelWorksheet = Nothing
Set objExcelWorkbook = Nothing
Set objExcelApplication = Nothing
'MsgBox "Done", vbOKOnly, "Done"
Exit Function
ErrorTrap:
Application.Echo True
'releases resources from excel and associated components
If Not objExcelApplication Is Nothing Then
objExcelApplication.Quit
If Not objExcelWorksheet Is Nothing Then
Set objExcelWorksheet = Nothing
End If
If Not objExcelWorkbook Is Nothing Then
Set objExcelWorkbook = Nothing
End If
Set objExcelApplication = Nothing
End If
'if recordset was created, closes recordset and sets to nothing
If Not rsCurrent Is Nothing Then
rsCurrent.Close
Set rsCurrent = Nothing
End If
MsgBox Err.Description & vbCrLf & Err.Number, vbOKOnly, "Error!"
End Function
Function fxGenerateTabbedExcelFromQueries(strReports As Variant,
strBRPPlan As
String) As String
Dim objExcelApplication As New Excel.Application
Dim objExcelWorkbook As Excel.Workbook
Dim objExcelWorksheet As Excel.Worksheet
'File Ralted variables
Dim strFileName As String
Dim strDate As String
Dim arrReports As Variant
Dim strCurrentDIR As String
Dim temp As Variant
Dim dbCurrent As DAO.Database
Dim rsCurrent As DAO.Recordset
Set dbCurrent = CurrentDb
'SQL String and replacement
Dim strSQLName As String
Dim strSQL As String
Dim strCombo As String
'Variables to manipulate recordset
Dim dblWorksheet As Double
Dim dblRow As Double
Dim dblColumn As Double
On Error GoTo ErrorTrap
'Variable for message boxes
Dim Response As Long
'creates date string for use in file name
strDate = Format(Date, "yyyy-mm-dd")
'replace with dynamic path
'creates file name string
strCurrentDIR = Application.CurrentProject.Path
strFileName = strCurrentDIR & "\" & "rptBCP_" & strDate & ".xls"
'creates array of report names, used in naming tabs and creating
recordsets to
populate Excel
arrReports = Split(strReports, ";")
'creates Excel Workbook
Set objExcelApplication = CreateObject("Excel.Application")
Set objExcelWorkbook = objExcelApplication.Workbooks.Add
'add requisiter number of sheets
If (UBound(arrReports)) > 0 Then
objExcelWorkbook.Worksheets.Add Count:=(UBound(arrReports))
End If
'Add visibility for error trapping
'objExcelApplication.Visible = True
'Creates and names tabs in worksheet, based on query names
For dblWorksheet = 0 To (UBound(arrReports))
'Default value in queries for reports, to be replaced
strCombo = "[Forms]![frmMainReports]![cboBusinessPlans]"
'CreateSQL string and recordset
strSQL = dbCurrent.QueryDefs(arrReports(dblWorksheet)).SQL
strSQL = Replace(strSQL, strCombo, Chr(34) & strBRPPlan & Chr(34))
Set rsCurrent = dbCurrent.OpenRecordset(strSQL, dbReadOnly)
objExcelWorkbook.Sheets(dblWorksheet + 1).Select
'If query description property does not exist, uses query name
'Needs to be fixed, as well as correction for duplicate names
'Needs to strip out carriage returns
On Error Resume Next
If
dbCurrent.QueryDefs(arrReports(dblWorksheet)).Properties("Description")
<> "" Then
objExcelWorkbook.Sheets(dblWorksheet + 1).Name =
Trim(dbCurrent.QueryDefs(arrReports(dblWorksheet)).Properties("Description"))
Else
objExcelWorkbook.Sheets(dblWorksheet + 1).Name =
Trim(arrReports(dblWorksheet))
End If
Set objExcelWorksheet = objExcelWorkbook.ActiveSheet
'set to zero for iteration through recordset and worksheet
dblRow = 0
dblColumn = 0
rsCurrent.MoveFirst
While Not rsCurrent.EOF
If dblRow = 0 Then
While dblColumn <> (rsCurrent.Fields.Count)
With objExcelWorksheet
.Cells(dblRow + 1, dblColumn + 1) =
rsCurrent(dblColumn).Name
.Cells(dblRow + 1, dblColumn +
1).Interior.ColorIndex = 1
' Black
.Cells(dblRow + 1, dblColumn + 1).Font.Color =
vbWhite
.Cells(dblRow + 1, dblColumn + 1).Font.Bold = True
dblColumn = dblColumn + 1
End With
Wend
End If
dblColumn = 0
While dblColumn <> (rsCurrent.Fields.Count)
objExcelWorksheet.Cells(dblRow + 2, dblColumn + 1) =
rsCurrent(dblColumn).Value
dblColumn = dblColumn + 1
Wend
dblColumn = 0
dblRow = dblRow + 1
rsCurrent.MoveNext
Wend
'Calls formatting function
Call fxFormatExcelSheets(objExcelApplication, objExcelWorkbook,
objExcelWorksheet)
'closes recordset
rsCurrent.Close
Set rsCurrent = Nothing
Next
'Saves workbook
'objExcelWorkbook.SaveAs strFileName
objExcelWorkbook.Worksheets(1).Select
objExcelApplication.Dialogs(xlDialogSaveAs).Show strFileName
'Sends e-Mail
strFileName = objExcelApplication.ActiveWorkbook.FullName
fxGenerateTabbedExcelFromQueries = strFileName
'Quits Excel and resets variables to Nothing
objExcelApplication.Quit
Set objExcelWorksheet = Nothing
Set objExcelWorkbook = Nothing
Set objExcelApplication = Nothing
Exit Function
ErrorTrap:
Application.Echo True
'releases resources from excel and associated components
If Not objExcelApplication Is Nothing Then
objExcelApplication.Quit
If Not objExcelWorksheet Is Nothing Then
Set objExcelWorksheet = Nothing
End If
If Not objExcelWorkbook Is Nothing Then
Set objExcelWorkbook = Nothing
End If
Set objExcelApplication = Nothing
End If
'if recordset was created, closes recordset and sets to nothing
If Not rsCurrent Is Nothing Then
rsCurrent.Close
Set rsCurrent = Nothing
End If
MsgBox Err.Description & vbCrLf & Err.Number, vbOKOnly, "Error!"
End Function
believe VB might be too much for what you need. I've pasted code which
calls two functions, one to create a spreadsheet, and one to attach the
XLS, by using CreatObject:
Option Compare Database
Option Explicit
Function fxCreateSpreadsheetCreateMail(strQueries As String, strBRPPlan
As
String, strSubject As String) As Boolean
Dim strFileName As String
Dim bResponse As Boolean
'generate spreadsheet
strFileName = fxGenerateTabbedExcelFromReports(strQueries, strBRPPlan)
'open outlook oand send spreadsheet
bResponse = fxCreateOutlookEmail(strFileName, strSubject)
Exit Function
End Function
Function fxCreateOutlookEmail(strAttachmentName As String, strSubject
As
String) As Boolean
Dim objOutlookApp As New Outlook.Application
Dim objOutlookMail As Outlook.MailItem
Dim objOutlookAttachments As Outlook.Attachments
On Error GoTo ErrorTrap
Set objOutlookApp = CreateObject("Outlook.Application")
Set objOutlookMail = objOutlookApp.CreateItem(olMailItem)
With objOutlookMail
.Subject = strSubject
.Body = vbCrLf & vbCrLf & strAttachmentName & vbCrLf & vbCrLf
.Attachments.Add strAttachmentName, olByValue, 500
End With
objOutlookMail.Display
fxCreateOutlookEmail = True
Exit Function
ErrorTrap:
'releases resources from outlook and associated components
If Not objOutlookApp Is Nothing Then
objOutlookApp.Quit
If Not objOutlookMail Is Nothing Then
Set objOutlookMail = Nothing
End If
If Not objOutlookAttachments Is Nothing Then
Set objOutlookAttachments = Nothing
End If
Set objOutlookApp = Nothing
End If
'returns false in case of error to calling module
fxCreateOutlookEmail = False
End Function
Function fxGenerateTabbedExcelFromReports(strReports As Variant,
strBRPPlan As
String) As String
Dim objExcelApplication As New Excel.Application
Dim objExcelWorkbook As Excel.Workbook
Dim objExcelWorksheet As Excel.Worksheet
'File Ralted variables
Dim strFileName As String
Dim strDate As String
Dim arrReports As Variant
Dim strCurrentDIR As String
Dim temp As Variant
Dim dbCurrent As DAO.Database
Dim rsCurrent As DAO.Recordset
Set dbCurrent = CurrentDb
'SQL String and replacement
Dim strSQLName As String
Dim strSQL As String
Dim strCombo As String
'Variables to manipulate recordset
Dim dblWorksheet As Double
Dim dblRow As Double
Dim dblColumn As Double
On Error GoTo ErrorTrap
'Variable for message boxes
Dim Response As Long
'creates date string for use in file name
strDate = Format(Date, "yyyy-mm-dd")
'replace with dynamic path
'creates file name string
strCurrentDIR = Application.CurrentProject.Path
strFileName = strCurrentDIR & "\" & "rptFoBo_" & Replace(strBRPPlan, "
", "")
& "_" & strDate & ".xls"
'creates array of report names, used in naming tabs and creating
recordsets to
populate Excel
arrReports = Split(strReports, ";")
'creates Excel Workbook
Set objExcelApplication = CreateObject("Excel.Application")
Set objExcelWorkbook = objExcelApplication.Workbooks.Add
'Removed most of the execution code
' for legibility
'Quits Excel and resets variables to Nothing
objExcelApplication.Quit
Set objExcelWorksheet = Nothing
Set objExcelWorkbook = Nothing
Set objExcelApplication = Nothing
'MsgBox "Done", vbOKOnly, "Done"
Exit Function
ErrorTrap:
Application.Echo True
'releases resources from excel and associated components
If Not objExcelApplication Is Nothing Then
objExcelApplication.Quit
If Not objExcelWorksheet Is Nothing Then
Set objExcelWorksheet = Nothing
End If
If Not objExcelWorkbook Is Nothing Then
Set objExcelWorkbook = Nothing
End If
Set objExcelApplication = Nothing
End If
'if recordset was created, closes recordset and sets to nothing
If Not rsCurrent Is Nothing Then
rsCurrent.Close
Set rsCurrent = Nothing
End If
MsgBox Err.Description & vbCrLf & Err.Number, vbOKOnly, "Error!"
End Function
Function fxGenerateTabbedExcelFromQueries(strReports As Variant,
strBRPPlan As
String) As String
Dim objExcelApplication As New Excel.Application
Dim objExcelWorkbook As Excel.Workbook
Dim objExcelWorksheet As Excel.Worksheet
'File Ralted variables
Dim strFileName As String
Dim strDate As String
Dim arrReports As Variant
Dim strCurrentDIR As String
Dim temp As Variant
Dim dbCurrent As DAO.Database
Dim rsCurrent As DAO.Recordset
Set dbCurrent = CurrentDb
'SQL String and replacement
Dim strSQLName As String
Dim strSQL As String
Dim strCombo As String
'Variables to manipulate recordset
Dim dblWorksheet As Double
Dim dblRow As Double
Dim dblColumn As Double
On Error GoTo ErrorTrap
'Variable for message boxes
Dim Response As Long
'creates date string for use in file name
strDate = Format(Date, "yyyy-mm-dd")
'replace with dynamic path
'creates file name string
strCurrentDIR = Application.CurrentProject.Path
strFileName = strCurrentDIR & "\" & "rptBCP_" & strDate & ".xls"
'creates array of report names, used in naming tabs and creating
recordsets to
populate Excel
arrReports = Split(strReports, ";")
'creates Excel Workbook
Set objExcelApplication = CreateObject("Excel.Application")
Set objExcelWorkbook = objExcelApplication.Workbooks.Add
'add requisiter number of sheets
If (UBound(arrReports)) > 0 Then
objExcelWorkbook.Worksheets.Add Count:=(UBound(arrReports))
End If
'Add visibility for error trapping
'objExcelApplication.Visible = True
'Creates and names tabs in worksheet, based on query names
For dblWorksheet = 0 To (UBound(arrReports))
'Default value in queries for reports, to be replaced
strCombo = "[Forms]![frmMainReports]![cboBusinessPlans]"
'CreateSQL string and recordset
strSQL = dbCurrent.QueryDefs(arrReports(dblWorksheet)).SQL
strSQL = Replace(strSQL, strCombo, Chr(34) & strBRPPlan & Chr(34))
Set rsCurrent = dbCurrent.OpenRecordset(strSQL, dbReadOnly)
objExcelWorkbook.Sheets(dblWorksheet + 1).Select
'If query description property does not exist, uses query name
'Needs to be fixed, as well as correction for duplicate names
'Needs to strip out carriage returns
On Error Resume Next
If
dbCurrent.QueryDefs(arrReports(dblWorksheet)).Properties("Description")
<> "" Then
objExcelWorkbook.Sheets(dblWorksheet + 1).Name =
Trim(dbCurrent.QueryDefs(arrReports(dblWorksheet)).Properties("Description"))
Else
objExcelWorkbook.Sheets(dblWorksheet + 1).Name =
Trim(arrReports(dblWorksheet))
End If
Set objExcelWorksheet = objExcelWorkbook.ActiveSheet
'set to zero for iteration through recordset and worksheet
dblRow = 0
dblColumn = 0
rsCurrent.MoveFirst
While Not rsCurrent.EOF
If dblRow = 0 Then
While dblColumn <> (rsCurrent.Fields.Count)
With objExcelWorksheet
.Cells(dblRow + 1, dblColumn + 1) =
rsCurrent(dblColumn).Name
.Cells(dblRow + 1, dblColumn +
1).Interior.ColorIndex = 1
' Black
.Cells(dblRow + 1, dblColumn + 1).Font.Color =
vbWhite
.Cells(dblRow + 1, dblColumn + 1).Font.Bold = True
dblColumn = dblColumn + 1
End With
Wend
End If
dblColumn = 0
While dblColumn <> (rsCurrent.Fields.Count)
objExcelWorksheet.Cells(dblRow + 2, dblColumn + 1) =
rsCurrent(dblColumn).Value
dblColumn = dblColumn + 1
Wend
dblColumn = 0
dblRow = dblRow + 1
rsCurrent.MoveNext
Wend
'Calls formatting function
Call fxFormatExcelSheets(objExcelApplication, objExcelWorkbook,
objExcelWorksheet)
'closes recordset
rsCurrent.Close
Set rsCurrent = Nothing
Next
'Saves workbook
'objExcelWorkbook.SaveAs strFileName
objExcelWorkbook.Worksheets(1).Select
objExcelApplication.Dialogs(xlDialogSaveAs).Show strFileName
'Sends e-Mail
strFileName = objExcelApplication.ActiveWorkbook.FullName
fxGenerateTabbedExcelFromQueries = strFileName
'Quits Excel and resets variables to Nothing
objExcelApplication.Quit
Set objExcelWorksheet = Nothing
Set objExcelWorkbook = Nothing
Set objExcelApplication = Nothing
Exit Function
ErrorTrap:
Application.Echo True
'releases resources from excel and associated components
If Not objExcelApplication Is Nothing Then
objExcelApplication.Quit
If Not objExcelWorksheet Is Nothing Then
Set objExcelWorksheet = Nothing
End If
If Not objExcelWorkbook Is Nothing Then
Set objExcelWorkbook = Nothing
End If
Set objExcelApplication = Nothing
End If
'if recordset was created, closes recordset and sets to nothing
If Not rsCurrent Is Nothing Then
rsCurrent.Close
Set rsCurrent = Nothing
End If
MsgBox Err.Description & vbCrLf & Err.Number, vbOKOnly, "Error!"
End Function
I