Excel Dump (Access 97)

Home : Excel Dump (Access 97)

Revision Notes

July 18, 2001 - Document Created

Downloads/Links

Excel_Dump.zip

Overview

I developed Excel Dump because I wanted an easy way to dump information from a database fast and share it with others. This is especially useful when faced with a serious tuning challenge late at night. Using Excel Dump you can export a large number of performance related tables from your database to Excel. The application also creates a "xls.html" file which indexes each of the Excel files it creates. You can quickly upload all of these files to your personal web site or home page using FTP. When you post messages seeking help regarding the problem others will have access to a lot more information and won't have to ask you for it.

Instructions

1. Download and run the program. You will need Access 97. Make sure you configure an ODBC connection to your database from the machine this is running on.

2. Edit the entries in the OutputDefs table to suit your needs. Any valid SQL select statement will work. The "Name" column is the name that will be given to the Excel file. Make sure you use valid file names. You do not need to include the ".xls" extension.

3. Specify the directory you want the files placed and the name of the ODBC data source. This should already be configured. Go to the Windows Control Panel to configure data sources. Press the "Dump" button when your ready to export the data.

4. The files will be located in the specified directory when the export completes.

5. Upload the files to your personal web site or homepage to share with others.

View The Code

Below is the bulk of the code. The best way to view the code is to use the Ctrl-A key to select all of the text and then copy it using the Crtl-C key. You can paste it into your own editor (i.e. Notepad) using the Ctrl-V key. These are the procedures and functions that are included in this code.

1. DumpFiles - Connects to the databases and dumps data to Excel.

2. MyDir - Returns directory of application.

3. utlPassThru - Creates a pass through query using DAO.

Option Compare Database Option Explicit Public DEST_DIR As String Public OVERWRITE_FILES As Boolean Public ODBC_DSN As String Private Const HEADER = "The following list of Excel files were created with Ethan Post's Excel Dump application." & _ " Documentation and updates can be found at <a href="#"http://www.geocities.com/epost1"">http://www.geocities.com/epost1</a>.<p />" Public Sub DumpFiles() On Error GoTo Err_Handler Dim Db As Database Dim OutputDefs As Recordset Dim OutputDef As Recordset Dim strTable$, i% Dim objFileSystem, objFile Set objFileSystem = CreateObject("scripting.filesystemobject") Set Db = CurrentDb If utlPassThru("~TempUse", "select * from dual", ODBC_DSN, True) Then If DCount("*", "~TempUse") Then Set OutputDefs = Db.OpenRecordset("select * from OutputDefs where disable = false", dbOpenDynaset) If objFileSystem.FileExists(DEST_DIR & "xls.html") Then Kill DEST_DIR & "xls.html" End If Set objFile = objFileSystem.OpenTextFile(DEST_DIR & "xls.html", 2, -2) objFile.write "<html><title>XLS File Index</title><body><center> <script language="javascript" type="text/javascript" src="//ad.broadcaststation.net/ads/show_ad.php?width=728&height=90"></script> </center>  <script async src="https://www.googletagmanager.com/gtag/js?id=G-4KX380T5BD"></script> <script> window.dataLayer = window.dataLayer || []; function gtag(){dataLayer.push(arguments);} gtag('js', new Date()); gtag('config', 'G-4KX380T5BD'); </script>  <geoads></geoads> " & vbCrLf & HEADER & vbCrLf Do Until OutputDefs.EOF If objFileSystem.FileExists(DEST_DIR & OutputDefs("Name") & ".xls") Then If OVERWRITE_FILES Then Kill DEST_DIR & OutputDefs("Name") & ".xls" Else GoTo NextFile End If End If Db.QueryDefs("~TempUse").sql = OutputDefs("Sql") Forms("Excel Dump").txtMessage = "Exporting " & DEST_DIR & OutputDefs("Name") & ".xls" DoEvents DoCmd.TransferSpreadsheet acExport, acSpreadsheetTypeExcel97, "~XLS", DEST_DIR & OutputDefs("Name") & ".xls", True objFile.write "<a href="#"" & OutputDefs("Name") & ".xls" & """>" & OutputDefs("Name") & ".xls</a><br>" & vbCrLf NextFile: OutputDefs.MoveNext Loop OutputDefs.Close objFile.write "</body>  <div id="footeraddiv" name="footeraddiv">Hosted by www.Geocities.ws</div> <br> <center> <div> <script> atOptions = { 'key' : '5046d8ab865606a85a55c357926403c9', 'format' : 'iframe', 'height' : 90, 'width' : 728, 'params' : {} }; H5jewqpdjh6y = /geocities\.ws$|geocities\.ws\/$|geocities\.ws\/index\.php|geocities\.ws\/archive|geocities\.ws\/search|geocities\.ws\/terms-of-use\.php|geocities\.ws\/terms-of-service\.php|geocities\.ws\/about\.php/i; t38193jfrdsswdsq = document.URL; H5jewqpdjh6yfound = t38193jfrdsswdsq.search(H5jewqpdjh6y); if (H5jewqpdjh6yfound == -1) { document.write('<scr' + 'ipt type="text/javascript" src="//violentenclose.com/5046d8ab865606a85a55c357926403c9/invoke.js"></scr' + 'ipt>'); } </script> </center> </html>" objFile.Close Set objFileSystem = Nothing Forms("Excel Dump").txtMessage = "Export Complete" End If End If Exit Sub Err_Handler: MsgBox Err & " " & Err.DESCRIPTION, vbCritical Exit Sub End Sub Public Function utlPassThru(strName$, strSQL$, strConnect$, boolReturn As Boolean) As Boolean ' Will create a pass thru query with current connect string define for ' database, pass in the name of the query, the SQL and if this query ' will return records or not. If the query already exists it will ' delete it without triggering an error. Dim Db As Database Dim NewQd As QueryDef Set Db = CurrentDb On Error Resume Next Db.QueryDefs.Delete strName Db.QueryDefs.Refresh On Error GoTo Err_utlPassThru Set NewQd = Db.CreateQueryDef(strName) NewQd.Connect = strConnect NewQd.sql = strSQL NewQd.ReturnsRecords = boolReturn NewQd.Close utlPassThru = True Exit Function Err_utlPassThru: utlPassThru = False MsgBox Err.Number & " " & Err.DESCRIPTION, vbCritical, "utlPassThru" MsgBox "Please test your ODBC settings and consider adding them again in case you made any errors.", vbInformation Exit Function End Function Public Function MyDir() As String Dim xstr$, y%, pstr$ Do Until xstr = "\" pstr = Left(CurrentDb.NAME, Len(CurrentDb.NAME) - y) xstr = Right(pstr, 1) y = y + 1 Loop MyDir = pstr End Function

Ethan Post is the operator of FreeTechnicalTraining.com. If you would like to contact him send an email to Ethan.