Export Access Report in Choice of Formats

;///////////////////////////////////////////////////////////////////
; Winbatch 2004B - Export Access Report in Choice of Formats      //
;                  Version 1: uses AskItemList()                  //
;                                                                 //
; Test Notes: the HTML output is really cool                      //
;             RTF is OK                                           //
;             Excel was not so great for the report chosen        //
;             tested on Access 2002                               //
;                                                                 //
; Stan Littlefield - May 25,2004 - please retain this header      //
;///////////////////////////////////////////////////////////////////

#DefineFunction exiterr(msg)
Display(2,"Unexpected Termination of Script",msg)
Exit
#EndFunction

IntControl(73,1,0,0,0)
p = FilePath( IntControl( 1004,0,0,0,0 ) )
DB = 0
; adjust to where your NorthWind MDB is located
cMDB = "C:\Program Files\Microsoft Office\Office10\Samples\northwind.mdb"
If ! FileExist(cMDB) Then exiterr("Cannot Fine %cMDB%")


list="XLS|RTF|SNAPSHOT|HTML|TEXT"
; I just picked a standard report in NorthWind
rpt = "Alphabetical List of Products"

cType = AskItemList("Select Report Format FOR: %rpt%", list, "|", @unsorted, @single)
DB = GetObject(cMDB, "Access.Application")
IF DB == 0 Then exiterr("Unable To Open Access Application Object")
;you might want to comment the next line until it works
;beats having invisible objects hanging around
DB.Visible = 0
nType = ItemLocate( cType, list, "|" )

;set Access Constants
;NOTE: these are not found in the Access.Application constants
;      but in the MS Office Library Constants
acOutputReport = 3
acViewPreview  = 2
acFormatXLS    = "Microsoft Excel (*.xls)"
acFormatRTF    = "Rich Text Format (*.rtf)"
acFormatSNP    = "Snapshot Format (*.snp)"  ; NOTE: snapshot viewer must be installed
acFormatHTML   = "HTML (*.html)"
acFormatTXT    = "MS-DOS Text (*.txt)"
; display after creating Output, change to @TRUE to test
show           =  @FALSE
Switch nType
   Case 1
      cOut = StrCat(p,"autoxls.xls")
      Display(1,"Writing Report AS...",cOut)
      DB.DoCmd.OutPutTo(acOutputReport,rpt,acFormatXLS,cOut,show)
      Break
   Case 2
      cOut = StrCat(p,"autortf.rtf")
      Display(1,"Writing Report AS...",cOut)
      DB.DoCmd.OutPutTo(acOutputReport,rpt,acFormatRTF,cOut,show)
      Break
   Case 3
      cOut = StrCat(p,"autosnap.snp")
      Display(1,"Writing Report Snapshot ...",cOut)
      DB.DoCmd.OutPutTo(acOutputReport,rpt,acFormatSNP,cOut,show)
      Break
   Case 4
      cOut = StrCat(p,"autohtml.htm")
      Display(1,"Writing Report AS...",cOut)
      DB.DoCmd.OutPutTo(acOutputReport,rpt,acFormatHTML,cOut,show,"NWINDTEM.HTM")
      Break
   Case 5
      cOut = StrCat(p,"autotxt.txt")
      Display(1,"Writing Report AS...",cOut)
      DB.DoCmd.OutPutTo(acOutputReport,rpt,acFormatTXT,cOut,show)
      Break
   ; if no report type selected, default to report preview
   Case nType
      DB.Visible = @TRUE
      DB.DoCmd.OpenReport(rpt,acViewPreview)
EndSwitch

DB.Quit()
DB=0

;this message may take several seconds depending upon the size of the report
If FileExist(cOut) Then Message(cOut,"Successfully Created!") 
Exit


:CANCEL
Exit

:WBERRORHANDLER        ;from Detlev
IntControl(73,1,0,0,0)
IF DB<>0
   DB.Quit()
   DB = 0
Endif
WbError = LastError()
WbTextcode = WbError
If WbError==1668||WbError==2669||WbError==3670
   ; 1668 ; "Minor user-defined error"
   ; 2669 ; "Moderate user-defined error"
   ; 3670 ; "Severe user-defined error"
   WbError = ItemExtract(1,IntControl(34,-1,0,0,0),":")
   WbTextcode = -1
EndIf
WbErrorString = IntControl(34,WbTextcode,0,0,0)
WbErrorDateTime = StrCat(TimeYmdHms(),"|",StrFixLeft(GetTickCount()," ",10))

WbErrorFile = StrCat(DirWindows(0),"WWWBATCH.INI")
IniWritePvt(WbErrorDateTime,"CurrentScript",WbErrorHandlerFile      ,WbErrorFile)
IniWritePvt(WbErrorDateTime,"ErrorValue"   ,WbError                 ,WbErrorFile)
IniWritePvt(WbErrorDateTime,"ErrorString"  ,WbErrorString           ,WbErrorFile)
IniWritePvt(WbErrorDateTime,"ScriptLine"   ,WbErrorHandlerLine      ,WbErrorFile)
IniWritePvt(WbErrorDateTime,"ScriptOffset" ,WbErrorHandlerOffset    ,WbErrorFile)
IniWritePvt(WbErrorDateTime,"VarAssignment",WbErrorHandlerAssignment,WbErrorFile)
IniWritePvt("","","",WbErrorFile)

WbErrorMsgText = StrCat(WbErrorDateTime,@CRLF)
WbErrorMsgText = StrCat(WbErrorMsgText,"Current Script: ",WbErrorHandlerFile,@CRLF)
WbErrorMsgText = StrCat(WbErrorMsgText,"LastError #:",WbError,@CRLF)
WbErrorMsgText = StrCat(WbErrorMsgText,"Error Text: ",wberrortextstring,@CRLF)
WbErrorMsgText = StrCat(WbErrorMsgText,"[Additional] ",wberroradditionalinfo,@CRLF,@CRLF)
; Line in script that caused Error.
WbErrorMsgText = StrCat(WbErrorMsgText,"WbErrorHandlerLine:",@CRLF,WbErrorHandlerLine,@CRLF)
; Offset into script of error line, in bytes.
WbErrorMsgText = StrCat(WbErrorMsgText,"WbErrorHandlerOffset: ",WbErrorHandlerOffset,@CRLF)
; Variable being assigned on error line, or "" if none.
WbErrorMsgText = StrCat(WbErrorMsgText,"WbErrorHandlerAssignment: ",WbErrorHandlerAssignment,@CRLF)
If (WbErrorHandlerAssignment>"") Then %WbErrorHandlerAssignment% = "UNKNOWN"
ClipPut(WbErrorMsgText)
WbErrorMsgText = StrCat(WbErrorMsgText,"[Error Copied To Clipboard]")
Message("wbErrorHandler",WbErrorMsgText)
Exit
;//////////////////////////////////////////////////////////////////////////////////////

Article ID:   W16594

File Created: 2005:02:18:12:21:34

Last Updated: 2005:02:18:12:21:34

Database Search

TechHome

Export Access Report in Choice of Formats