The problem I had was solved by referencing the Accpac Signon Manager and Accpac Session Manager and forcing some Accpac Signoffs. The coding below works a treat for me. The macros operate out of an Excel file. There are actually twenty databases in the live version (the code below shows two databases only). The macro will now open a specified Accpac database, run a specified FR report, cut/paste the FR report output to a specified location in the Excel file. I can also run a macro that runs all report generations in one go. Hope the code maybe of use to someone else.
Const AccpacUser = "ADMIN"
Const AccpacPassword = "ADMIN"
Dim AccpacDatabase As String
Const ExcelSourceFilePath = "C:\Documents and Settings\Colin Hamilton\My Documents\CCG\CLIENT_METHOTGRO\MHG_REPORTS_BIN\"
Dim ExcelSourceFileName As String
Const ExcelTempFilePath = "C:\Documents and Settings\Colin Hamilton\My Documents\CCG\CLIENT_METHOTGRO\MHG_REPORTS_BIN\"
Const ExcelTempFileName = "MHG_REPORTS_TEMP_FILE.xls"
Dim ExcelSheetName As String
Public Sub IMPORT00_ALL_REPORTS()
Call IMPORT01_ALBANY_REPORT
Call IMPORT02_ASPIRE_REPORT
Dim Title01, Message01, Style01, Response01
Title01 = "IMPORT ALL REPORTS"
Message01 = "Import Process Completed"
Style01 = vbOKOnly
Response01 = MsgBox(Message01, Style01, Title01)
End Sub
Public Sub IMPORT01_ALBANY_REPORT()
AccpacDatabase = "TES001"
ExcelSourceFileName = "MHG_REPORTS_ALBANY.xls"
ExcelSheetName = "ALBANY"
Call IMPORT_FR_REPORT
End Sub
Public Sub IMPORT02_ASPIRE_REPORT()
AccpacDatabase = "TES012"
ExcelSourceFileName = "MHG_REPORTS_ASPIRE.xls"
ExcelSheetName = "ASPIRE"
Call IMPORT_FR_REPORT
End Sub
Private Sub IMPORT_FR_REPORT()
On Error GoTo ERROR_PROCEDURE1
Dim mSession As AccpacSession
Dim mSessMgr As AccpacSessionMgr
Dim mSignMgr As AccpacSignonMgr
Dim mDBLinkCmpRW As New AccpacCOMAPI.AccpacDBLink
Dim mDBLinkSysRW As New AccpacCOMAPI.AccpacDBLink
Set mSession = New AccpacCOMAPI.AccpacSession
Set mSessMgr = New AccpacSessionMgr
Set mSignMgr = New AccpacSignonMgr
mSessMgr.Signoff (0)
mSessMgr.Signoff (1)
mSessMgr.Signoff (2)
Dim mSignOn As New AccpacSignonManager.AccpacSignonMgr
Dim MSignId As Long
mSession.Init "", "AS", "AS1000", "55A"
mSession.Open AccpacUser, AccpacPassword, AccpacDatabase, Date, 0, ""
If mSession.IsOpened = True Then
MSignId = mSignOn.RegisterSignon(AccpacUser, AccpacPassword, AccpacDatabase, "", Date)
Set mDBLinkCmpRW = mSession.OpenDBLink(DBLINK_COMPANY, DBLINK_FLG_READWRITE)
Set mDBLinkSysRW = mSession.OpenDBLink(DBLINK_SYSTEM, DBLINK_FLG_READWRITE)
End If
'
On Error Resume Next
Kill ExcelTempFilePath & ExcelTempFileName
'
On Error GoTo ERROR_PROCEDURE2
Dim GLFRRPT As Object
Set GLFRRPT = CreateObject("AccpacGL9100.AccpacMacro")
GLFRRPT.CmdFRSelect ExcelSourceFilePath & ExcelSourceFileName
GLFRRPT.ReportType "1" ' 1=Actual, 2=Provisional
GLFRRPT.Year Range("FISCAL_YEAR") ' Year is YYYY
GLFRRPT.Period Range("FISCAL_PERIOD") ' Period is 1 - 13
GLFRRPT.InclOptions "0" ' 0=Do not include options, 1=Include options
GLFRRPT.SortBy "2" ' 1=AcctNo Order,2=Segment Order,3=AcctGroup Order
GLFRRPT.SortBySegId "3"
GLFRRPT.FromAcctGroupSelectBy "0"
GLFRRPT.FromSortGroup ""
GLFRRPT.ToSortGroup ""
GLFRRPT.FromAcctGroup ""
GLFRRPT.ToAcctGroup "ZZZZZZZZZZZZ"
GLFRRPT.FromAcSeg0 ""
GLFRRPT.ToAcSeg0 "ZZZ"
GLFRRPT.AcSegReportAs0 "1" ' 1=Consolidated, 2=Separate
GLFRRPT.FromAcSeg1 ""
GLFRRPT.ToAcSeg1 "ZZZ"
GLFRRPT.AcSegReportAs1 "1" ' 1=Consolidated, 2=Separate
GLFRRPT.FromAcSeg2 ""
GLFRRPT.ToAcSeg2 "ZZZZZZ"
GLFRRPT.AcSegReportAs2 "1" ' 1=Consolidated, 2=Separate
GLFRRPT.FromAcSeg3 ""
GLFRRPT.ToAcSeg3 "ZZ"
GLFRRPT.AcSegReportAs3 "1" ' 1=Consolidated, 2=Separate
GLFRRPT.CmdFRFileFormat 1
GLFRRPT.CmdFRPrintEx2 mDBLinkCmpRW, "file", 1, ExcelTempFilePath, ExcelTempFileName, 0
Set GLFRRPT = Nothing
'
On Error GoTo ERROR_PROCEDURE3
mDBLinkCmpRW.Close
mDBLinkSysRW.Close
Set mSession = Nothing
mSession.Close
mSessMgr.Signoff (0)
mSessMgr.Signoff (1)
mSessMgr.Signoff (2)
'
On Error GoTo ERROR_PROCEDURE4
Windows("MHG_REPORTS_GROUP.xls").Activate
Sheets(ExcelSheetName).Select
Columns("A:Z").ClearContents
Columns("A:Z").ClearFormats
Range("A1").Select
Workbooks.Open Filename:=ExcelTempFilePath & ExcelTempFileName
Range("Print_Area").Copy
Windows("MHG_REPORTS_GROUP.xls").Activate
ActiveSheet.Paste
Range("A1").Select
Workbooks(ExcelTempFileName).Save
Workbooks(ExcelTempFileName).Close
Kill ExcelTempFilePath & ExcelTempFileName
Sheets("Fiscal Calendar").Select
Range("A1").Select
Exit Sub
ERROR_PROCEDURE1:
On Error Resume Next
Dim Title01, Message01, Style01, Response01
Title01 = "IMPORT FR REPORT"
Message01 = "Accpac Logon Error Encountered"
Style01 = vbOKOnly + vbCritical
Response01 = MsgBox(Message01, Style01, Title01)
Exit Sub
ERROR_PROCEDURE2:
On Error Resume Next
Dim Title02, Message02, Style02, Response02
Title02 = "IMPORT FR REPORT"
Message02 = "FR Report Generation Error Encountered"
Style02 = vbOKOnly + vbCritical
Response02 = MsgBox(Message02, Style02, Title02)
Exit Sub
ERROR_PROCEDURE3:
On Error Resume Next
Dim Title03, Message03, Style03, Response03
Title03 = "IMPORT FR REPORT"
Message03 = "Accpac Logoff Error Encountered"
Style03 = vbOKOnly + vbCritical
Response03 = MsgBox(Message03, Style03, Title03)
Exit Sub
ERROR_PROCEDURE4:
On Error Resume Next
Dim Title04, Message04, Style04, Response04
Title04 = "IMPORT FR REPORT"
Message04 = "Report Copy/Paste Error Encountered"
Style04 = vbOKOnly + vbCritical
Response04 = MsgBox(Message04, Style04, Title04)
Exit Sub
End Sub