You guys are extremely helpful! I feel like I am on my way to becoming an ACCPAC programmer
I have looked at the bas.abv macro although I'm midly concerned mine may be different to yours; my "bas.abv" generates business activity statements which satisfy the Australian tax office's requirements. Although this sample makes sense to me (in Australia) is this the same sample used worldwide?
I am having a problem with the routine to prepare the INI file. In particular, I get an error 'The "Session" Object was was not opened'. I believe this is in the line "With session.ActiveApplications".
I do appreciate the tremendous help so far and I feel confident if I can get this report going my ACCPAC abilities will be greatly enhanced!
Here is my code, in two files.
First, the file frmInvoiceSummary which contains the UI:
-------------------------------------------
Option Explicit
Private Sub bClose_Click()
Unload Me
End Sub
Private Sub bPrint_Click()
On Error GoTo ACCPACErrorHandler
Dim BegDate As String, EndDate As String
BegDate = Format(dateFrom.Value, "yyyymmdd"
EndDate = Format(dateTo.Value, "yyyymmdd"
'// Set the report.
Dim InvoiceSummaryReport As ACCPACXAPILib.xapiReport
Set InvoiceSummaryReport = CreateObject("ACCPAC.xapiReport"
InvoiceSummaryReport.Select session, "ARINVSUM", ""
'// Feed the report parameteres.
InvoiceSummaryReport.SetParam "StartDate", BegDate
InvoiceSummaryReport.SetParam "EndDate", EndDate
InvoiceSummaryReport.NumOfCopies = 1
InvoiceSummaryReport.PrintDestination = PD_PREVIEW
InvoiceSummaryReport.PrintReport 1
Exit Sub
ACCPACErrorHandler:
Dim Error As Variant
If Errors.Count = 0 Then
MsgBox Err.Description
Else
For Each Error In Errors
MsgBox Error.Description
Next
Errors.Clear
End If
Resume Next
End Sub
-------------------------------------------
Next, MainModule -
-------------------------------------------
Option Explicit
' Produce an invoice summary report, between specified dates
' and for specified customers
Global strAccpacDir As String 'The directory where ACCPAC was installed.
Global session As xapiSession 'Current ACCPAC Session
Declare Function RegOpenKeyEx Lib "advapi32" Alias "RegOpenKeyExA" _
(ByVal hKey As Long, ByVal lpSubKey As String, ByVal ulOptions As Long, _
ByVal samDesired As Long, phkResult As Long) As Long
Declare Function RegQueryValueEx Lib "advapi32" Alias "RegQueryValueExA" _
(ByVal hKey As Long, ByVal lpValueName As String, ByVal lpReserved As Long, _
ByRef lpType As Long, ByVal lpData As String, ByRef lpcbData As Long) As Long
Declare Function RegCloseKey Lib "advapi32" (ByVal hKey As Long) As Long
Declare Function GetPrivateProfileSection Lib "Kernel32" Alias "GetPrivateProfileSectionA" _
(ByVal lpAppName As String, ByVal lpReturnedString As String, _
ByVal nSize As Long, ByVal lpFileName As String) As Long
Declare Function WritePrivateProfileString Lib "Kernel32" Alias "WritePrivateProfileStringA" _
(ByVal lpAppName As String, ByVal lpKeyName As String, _
ByVal lpString As String, ByVal lpFileName As String) As Boolean
Public Const HKEY_LOCAL_MACHINE As Long = &H80000002
Public Const KEY_QUERY_VALUE As Long = &H1
Public Const REG_SZ = (1) 'Unicode nul terminated string
Sub MainSub()
' Set up the ACCPAC environment
Initialise_Session
' Get the current date
Dim theDate As Date
theDate = Date
' Set the report defaults to be the entire last month
Dim NumDay As Integer
Dim NumMonth As Integer
NumDay = Day(theDate)
NumMonth = Month(theDate)
Dim fromDate As Date
fromDate = CDate(DateAdd("d", -(NumDay - 1), DateAdd("m", -1, theDate)))
Dim toDate As Date
toDate = CDate(DateAdd("d", -NumDay, theDate))
Dim frmMain As New frmInvoiceSummary
frmMain.dateFrom.Value = fromDate
frmMain.dateTo.Value = toDate
frmMain.Show
Set frmMain = Nothing
End Sub
Public Sub Initialise_Session()
On Error GoTo ErrorHandler
' An elegant way to know the installation directory is to check the registry.
' However, for unknown reasons, this won't work in NT environment.
' Therefore I just assume that the macro is started from "${strAccpacDir}\Runtime" directory.
' Retrieve the installation directory of ACCPAC
Dim hKeyResult As Long
Dim cbData As Long
Dim nType As Long
RegOpenKeyEx HKEY_LOCAL_MACHINE, _
"Software\ACCPAC INTERNATIONAL, INC.\ACCPAC\Configuration" & vbNullChar, _
0, KEY_QUERY_VALUE, hKeyResult
strAccpacDir = String(1024, vbNullChar)
cbData = 128
nType = REG_SZ
RegQueryValueEx hKeyResult, "Programs" & vbNullChar, 0, nType, strAccpacDir, cbData
RegCloseKey hKeyResult
Dim nPos As Long
nPos = InStr(1, strAccpacDir, vbNullChar)
If nPos > 1 Then
strAccpacDir = Trim(Left(strAccpacDir, InStr(1, strAccpacDir, vbNullChar) - 1))
ChDir (strAccpacDir & "\Runtime"
Else
strAccpacDir = InputBox("Please specifiy the installation directory of your ACCPAC package."
' strAccpacDir = CurDir()
' strAccpacDir = Left(strAccpacDir, InStrRev(strAccpacDir, "\"
- 1)
End If
Set session = ACCPACXAPILib.session
Prepare_Rpt_Ini
Exit Sub
ErrorHandler:
MsgBox Err.Description
End
Resume Next
End Sub
'Read the ARINVSUM.INI and append a section for BAS reports if not exist..
Public Sub Prepare_Rpt_Ini()
On Error GoTo ErrorHandler
Dim iApp As Integer
Dim strIniFile As String
Dim strPgmId As String
Dim strPgmVer As String
' ***********************************
' **** ERROR BELOW ******************
With session.ActiveApplications
For iApp = 0 To .Count - 1
If .Item(iApp).PgmID = "AR" Then
Exit For
End If
Next iApp
If iApp = .Count Then
Exit Sub
End If
strPgmId = .Item(iApp).PgmID
strPgmVer = .Item(iApp).PgmVer
strIniFile = strAccpacDir & "\" & .Item(iApp).PgmID & .Item(iApp).PgmVer & "\ARINVSUM.INI"
End With
Dim strSection As String
Dim strReportName As String
Dim strKey As String
Dim strValue As String
Dim nLenSection As Integer
'Check section ARINVSUM
strSection = String(4096, vbNullChar)
nLenSection = Len(strSection)
strIniFile = strIniFile & vbNullChar
strReportName = "ARINVSUM" & vbNullChar
GetPrivateProfileSection strReportName, strSection, nLenSection, strIniFile
strSection = Trim(Left(strSection, InStr(1, strSection, vbNullChar) - 1))
If Len(strSection) = 0 Then
'ARINVSUM does not exist.
strKey = "crystal" & vbNullChar
strValue = strAccpacDir & "\" & strPgmId & strPgmVer & "\ENG\SQLS\ARINVSUM.rpt" & vbNullChar
WritePrivateProfileString strReportName, strKey, strValue, strIniFile
strKey = "orientation" & vbNullChar
strValue = "landscape" & vbNullChar
WritePrivateProfileString strReportName, strKey, strValue, strIniFile
strKey = "paper size" & vbNullChar
strValue = "1" & vbNullChar
WritePrivateProfileString strReportName, strKey, strValue, strIniFile
End If
Exit Sub
ErrorHandler:
HandleError
Exit Sub
FileNotExists:
Exit Sub
End Sub
'Error handling routine.
Public Sub HandleError()
Dim Errors As xapiErrors
Dim Error As Variant
Set Errors = session.Errors
If Errors.Count = 0 Then
MsgBox Err.Description
Else
For Each Error In Errors
MsgBox Error.Description
Next
Errors.Clear
End If
Set Errors = Nothing
End Sub
-------------------------------------------
David M. Williams
National I.T. Manager
Advantage Personnel Pty. Ltd.
AUSTRALIA
