Option Explicit

'exports various sources as delimited text (see sample usage below for details)
'code by Dimitri Furman <dfurman@cloud9.net>, unless otherwise noted
'last modified on 10/3/2000
'requires DAO reference
'works in VB/VBA
'two conditional compilation constants below
'are currently set for use in Access 97.

'ญญญญญญญญญญญญญญญญญญญญญญญญญญญญญญญญญญญญญญญญญญญญญญญญญ 
' Sample usage:
' 
' Sub TEDemo()
' On Error GoTo Err_Handler
' Dim TE As TextExport
' 
' Set TE = New TextExport
' 
' With TE
'   .NoProgressBar = False 'optional, default is False
'   .ExportDatabase = CurrentDb 'required if ExportSource is a table name, a query name, or a SQL statement; no default
'   .ExportType = "ASCII" 'optional, ASCII or WP (WordPefrect merge), default is ASCII
'   .ExportSource = "tblErrLog" 'required, either recordset, or tabledef, or querydef, or table name, or query name, or SQL statement, or 2D-array (1st dimension - "columns", 2nd dimension - "rows")
'   .AppendToFile = False 'optional, default is False
'   .ExportFilename = "c:\temp\file.txt" 'required, existing file will be overwritten unless AppendToFile is set to True
'   .TextQualifier = Chr(34) 'optional, any string, default is "
'   .FieldDelimiter = vbTab 'optional, any string, default is Tab
'   .RecDelimiter = vbCrLf 'optional, any string, default is CrLf
'   .ReplaceWith = " " 'optional, any string, used to replace delimiters found in data, default is one space
'   .IncludeFieldNames = True 'optional, default is True, ignored for arrays
'   .ExcludeFields = "FieldName." 'optional, dot-delimited string of source fields to exclude, ignored for arrays
'   .Export
'   MsgBox .RecordCount & " records exported." 'number of actually exported records
' End With
' 
' Exit_Here:
'   On Error Resume Next
'   Set TE = Nothing
'   Exit Sub
' 
' Err_Handler:
'   MsgBox Err.Number & ": " & Err.Description
'   Resume Exit_Here
' 
' End Sub
' 
'ญญญญญญญญญญญญญญญญญญญญญญญญญญญญญญญญญญญญญญญญญญญญญญญญญ 

#Const VBA5 = True 'True for MS Office 97, False for VB and MS Office 2000
#Const Access = True 'True for Access any version, False otherwise

#If VBA5 Then
#Else
  Public Event StatusText(ByVal strStatusText As String)
  Public Event ExportProgress(ByVal sngPercentDone As Single)
#End If

#If Access Then
#Else
  Private Const acSysCmdInitMeter = 1
  Private Const acSysCmdUpdateMeter = 2
  Private Const acSysCmdSetStatus = 4
  Private Const acSysCmdClearStatus = 5
#End If

Private mrsExport As DAO.Recordset
Private mvarExport As Variant
Private mstrTextQualifier As String
Private mstrFieldDelimiter As String
Private mstrRecDelimiter As String
Private mstrReplaceWith As String
Private mstrExportFilename As String
Private mstrExportType As String
Private mblnIncludeFieldNames As Boolean
Private mstrExcludeFields As String
Private mblnNoProgress As Boolean
Private mblnAppend As Boolean
Private mlngExportedCount As Long

Private mintFileNumber As Integer
Private mdbCurrent As DAO.Database
Private mintErrHandling As Integer
Private Type ArrayLayout
  ColumnDimension As Long
  RowDimension As Long
End Type
Private mAL As ArrayLayout 'orientation of the source array

Private Const mconERR_INVALID_EXPORT_SOURCE = vbObjectError Or 1000
Private Const mconERR_INVALID_EXPORT_ARRAY = vbObjectError Or 1005
Private Const mconERR_EXP_DB_NOT_SPECIFIED = vbObjectError Or 1010
Private Const mconERR_BAD_DAO_REFERENCE = vbObjectError Or 1015
Private Const mconERR_INVALID_EXCLUDE_LIST = vbObjectError Or 1020

Public Property Let ExcludeFields(strExcludeFields As String)
'optional, .-delimited string of fields to exclude
'ignored for arrays

If Not strExcludeFields Like "[!.]*?." Then _
  Err.Raise mconERR_INVALID_EXCLUDE_LIST, "TextExport::ExcludeFields", "Invalid exclude field list format."

mstrExcludeFields = strExcludeFields

End Property

Public Property Let ExportDatabase(db As DAO.Database)
'required if ExportSource is a table name, a query name, or a SQL statement
'no default
  Set mdbCurrent = db
End Property

Public Function Export(Optional blnTransposeArray As Boolean) As Boolean
'wrapper for ExportRs or ExportArr

If Not IsEmpty(mvarExport) Then
  If blnTransposeArray Then
    mAL.ColumnDimension = 2
    mAL.RowDimension = 1
  End If
  Export = ExportArr
ElseIf Not mrsExport Is Nothing Then
  Export = ExportRs
Else
  Err.Raise mconERR_INVALID_EXPORT_SOURCE, "TextExport::Export", "Invalid export source."
End If

End Function

Private Function ExportRs() As Boolean
On Error GoTo Err_Handler
Dim strHeader As String, strRecord As String
Dim intCount As Integer
Dim fld As DAO.Field
Dim lngFilePos As Long

If Not mrsExport.Fields.Count > 0 Then _
  Err.Raise mconERR_INVALID_EXPORT_SOURCE, "TextExport::Export", "Invalid export source."

If mstrExportType = "WP" Then
  mstrTextQualifier = vbNullString
  mstrFieldDelimiter = Chr(18) & Chr(10)
  mstrRecDelimiter = Chr(5) & Chr(10)
  strHeader = Chr(255) & "WPC^" & String$(3, vbNullChar) & Chr(1) & Chr(10) & String$(6, vbNullChar) & Chr(251) & Chr(255) _
              & Chr(5) & vbNullChar & "2" & String$(5, vbNullChar) & Chr(6) & vbNullChar & Chr(8) & String$(3, vbNullChar) & "B" & String$(3, vbNullChar) _
              & Chr(8) & vbNullChar & Chr(2) & String$(3, vbNullChar) & "J" & String$(3, vbNullChar) & Chr(1) & vbNullChar _
              & Chr(18) & String$(3, vbNullChar) & "L" & String$(13, vbNullChar) & Chr(8) & vbNullChar & "|" _
              & vbNullChar & "x" & String$(5, vbNullChar) & Format$(Now, "mmm dd, yyyy") & String$(6, vbNullChar)
End If

If mblnIncludeFieldNames Then
  For intCount = 0 To mrsExport.Fields.Count - 1
    If Not (InStr(1, mstrExcludeFields, mrsExport.Fields(intCount).Name & ".", vbTextCompare) > 0) Then
      strHeader = strHeader & mstrTextQualifier & ReplaceString(mrsExport.Fields(intCount).Name, mstrRecDelimiter, mstrReplaceWith) & mstrTextQualifier & mstrFieldDelimiter
    End If
  Next intCount
  strHeader = Left$(strHeader, Len(strHeader) - Len(mstrFieldDelimiter)) & mstrRecDelimiter
End If

mintFileNumber = FreeFile
Open mstrExportFilename For Binary Access Write Lock Write As mintFileNumber

If mblnAppend Then _
  lngFilePos = LOF(mintFileNumber)

Put #mintFileNumber, lngFilePos + 1, strHeader 'wrote header, if any

With mrsExport
  Call SysCmd(acSysCmdSetStatus, "Opening source...")
  If mrsExport.RecordCount > 0 Then
    .MoveLast 'to get accurate progress bar
    Call SysCmd(acSysCmdClearStatus)
    .MoveFirst
    Call SysCmd(acSysCmdInitMeter, "Exporting text...", 100)
  End If
  mlngExportedCount = 0
  Do Until .EOF
    Call SysCmd(acSysCmdUpdateMeter, .PercentPosition)
    strRecord = vbNullString
    For intCount = 0 To .Fields.Count - 1
      If Not (InStr(1, mstrExcludeFields, .Fields(intCount).Name & ".", vbTextCompare) > 0) Then
        Set fld = .Fields(intCount)
        Select Case fld.Type
          Case dbText, dbMemo, dbChar
            If Len(mstrTextQualifier) > 0 Then
              strRecord = strRecord & CStr(Nz(mstrTextQualifier + fld.value + mstrTextQualifier, vbNullString)) & mstrFieldDelimiter
            Else 'make sure there's no field delimiters in text fields
              strRecord = strRecord & ReplaceString(Nz(fld.value, vbNullString), mstrFieldDelimiter, mstrReplaceWith) & mstrFieldDelimiter
            End If
          Case dbGUID 'exports canonical form
            strRecord = strRecord & Mid$(Nz(fld.value, vbNullString), 7, 38) & mstrFieldDelimiter
          Case Else
            strRecord = strRecord & Nz(fld.value, vbNullString) & mstrFieldDelimiter
        End Select
        Set fld = Nothing
      End If
    Next intCount
    strRecord = ReplaceString(strRecord, mstrRecDelimiter, mstrReplaceWith) 'make sure there's no record delimiters in records
    strRecord = Left$(strRecord, Len(strRecord) - Len(mstrFieldDelimiter)) & mstrRecDelimiter
    Put #mintFileNumber, , strRecord
    mlngExportedCount = mlngExportedCount + 1
    .MoveNext
  Loop
End With

ExportRs = True

Exit_Here:
  On Error Resume Next
  Set fld = Nothing
  Close mintFileNumber
  Call SysCmd(acSysCmdClearStatus)
  Exit Function

Err_Handler:
  Err.Raise Err.Number, Err.Source, Err.Description
  Resume Exit_Here

End Function

Private Function ExportArr() As Boolean
'1st dimension - "columns", 2nd dimension - "rows"
'or the other way when transposed (Me.Export(True))
On Error GoTo Err_Handler
Dim strHeader As String, strRecord As String
Dim lngRowCount As Long, lngColumnCount As Long
Dim lngTotalRows As Long
Dim varElement As Variant
Dim lngFilePos As Long

If mstrExportType = "WP" Then
  mstrTextQualifier = vbNullString
  mstrFieldDelimiter = Chr(18) & Chr(10)
  mstrRecDelimiter = Chr(5) & Chr(10)
  strHeader = Chr(255) & "WPC^" & String$(3, vbNullChar) & Chr(1) & Chr(10) & String$(6, vbNullChar) & Chr(251) & Chr(255) _
              & Chr(5) & vbNullChar & "2" & String$(5, vbNullChar) & Chr(6) & vbNullChar & Chr(8) & String$(3, vbNullChar) & "B" & String$(3, vbNullChar) _
              & Chr(8) & vbNullChar & Chr(2) & String$(3, vbNullChar) & "J" & String$(3, vbNullChar) & Chr(1) & vbNullChar _
              & Chr(18) & String$(3, vbNullChar) & "L" & String$(13, vbNullChar) & Chr(8) & vbNullChar & "|" _
              & vbNullChar & "x" & String$(5, vbNullChar) & Format$(Now, "mmm dd, yyyy") & String$(6, vbNullChar)
End If

mintFileNumber = FreeFile
Open mstrExportFilename For Binary Access Write Lock Write As mintFileNumber

If mblnAppend Then _
  lngFilePos = LOF(mintFileNumber)

Put #mintFileNumber, lngFilePos + 1, strHeader 'wrote header, if any

Call SysCmd(acSysCmdSetStatus, "Opening source...")
lngTotalRows = UBound(mvarExport, mAL.RowDimension) - LBound(mvarExport, mAL.RowDimension)
If lngTotalRows > 0 Then
  Call SysCmd(acSysCmdClearStatus)
  Call SysCmd(acSysCmdInitMeter, "Exporting text...", lngTotalRows)
End If

mlngExportedCount = 0
For lngRowCount = LBound(mvarExport, mAL.RowDimension) To UBound(mvarExport, mAL.RowDimension)
  Call SysCmd(acSysCmdUpdateMeter, lngRowCount)
  strRecord = vbNullString
For lngColumnCount = LBound(mvarExport, mAL.ColumnDimension) To UBound(mvarExport, mAL.ColumnDimension)
    If mAL.ColumnDimension = 2 And mAL.RowDimension = 1 Then 'transposed
      varElement = mvarExport(lngRowCount, lngColumnCount)
    Else
      varElement = mvarExport(lngColumnCount, lngRowCount)
    End If
    Select Case VarType(varElement)
      Case vbString
        If Len(mstrTextQualifier) > 0 Then
          strRecord = strRecord & mstrTextQualifier & varElement & mstrTextQualifier & mstrFieldDelimiter
        Else 'make sure there's no field delimiters in text fields
          strRecord = strRecord & ReplaceString(varElement, mstrFieldDelimiter, mstrReplaceWith) & mstrFieldDelimiter
        End If
      Case vbEmpty, vbNull, vbInteger, vbLong, vbSingle, vbDouble, _
           vbCurrency, vbDate, vbBoolean, vbDecimal, vbByte
        strRecord = strRecord & Nz(varElement, vbNullString) & mstrFieldDelimiter
      Case Else 'unexportable element, shouldn't happen (supposed to be validated previously)
        Err.Raise mconERR_INVALID_EXPORT_ARRAY, "TextExport::ExportSource", "Invalid export array."
    End Select
  Next lngColumnCount
  strRecord = ReplaceString(strRecord, mstrRecDelimiter, mstrReplaceWith) 'make sure there's no record delimiters in records
  strRecord = Left$(strRecord, Len(strRecord) - Len(mstrFieldDelimiter)) & mstrRecDelimiter
  Put #mintFileNumber, , strRecord
  mlngExportedCount = mlngExportedCount + 1
Next lngRowCount

ExportArr = True

Exit_Here:
  On Error Resume Next
  Close mintFileNumber
  Call SysCmd(acSysCmdClearStatus)
  Exit Function

Err_Handler:
  Err.Raise Err.Number, Err.Source, Err.Description
  Resume Exit_Here

End Function

Public Property Let ExportFilename(strExpFilename As String)
'required
On Error GoTo 0
Dim intFileNumber As Integer

If Not mblnAppend Or Not FileExists(strExpFilename) Then
  intFileNumber = FreeFile
  Open strExpFilename For Output Access Write Lock Read Write As intFileNumber
  Close intFileNumber 'set to 0-length/create a 0-length
End If

mstrExportFilename = strExpFilename

End Property

Public Property Let ExportSource(varSource As Variant)
'required
'accepts a recordset, a tabledef, a querydef,
'a table name, a query name, a SQL statement
'or a 2-dim array
On Error GoTo 0
Dim strQueryName As String, strTableName As String
Dim qdf As DAO.QueryDef
Dim varElement As Variant

If IsObject(varSource) Then 'recordset or querydef or tabledef
  If TypeOf varSource Is DAO.Recordset Then
    If Not varSource Is Nothing Then Set mrsExport = varSource.Clone 'work with a copy
  ElseIf TypeOf varSource Is DAO.TableDef Or TypeOf varSource Is DAO.QueryDef Then
   Call SysCmd(acSysCmdSetStatus, "Opening source...")
   Set mrsExport = varSource.OpenRecordset(dbOpenSnapshot)
   Call SysCmd(acSysCmdClearStatus)
  Else
    Err.Raise mconERR_INVALID_EXPORT_SOURCE, "TextExport::ExportSource", "Invalid export source."
  End If
ElseIf TypeName$(varSource) = "String" Then 'table name or query name or SQL
  If mdbCurrent Is Nothing Then _
    Err.Raise mconERR_EXP_DB_NOT_SPECIFIED, "ExportText::ExportSource", "Database not specified."
  'try to use as SQL
  If Not mrsExport Is Nothing Then mrsExport.Close: Set mrsExport = Nothing
  Call SysCmd(acSysCmdSetStatus, "Opening source...")
  On Error Resume Next
  Set mrsExport = mdbCurrent.OpenRecordset(CStr(varSource), dbOpenSnapshot)
  On Error GoTo 0
  Call SysCmd(acSysCmdClearStatus)
  If mrsExport Is Nothing Then 'try as table name or query name
    'if there's a table and a query with the same name, will use the query
    On Error Resume Next
    strQueryName = mdbCurrent.QueryDefs(CStr(varSource)).Name
    If Not Len(strQueryName) > 0 Then _
      strTableName = mdbCurrent.TableDefs(CStr(varSource)).Name
    On Error GoTo 0
    If Len(strQueryName) > 0 Then
      If Not (mdbCurrent.QueryDefs(strQueryName).Type = dbQSelect Or mdbCurrent.QueryDefs(strQueryName).Type = dbQSetOperation) Then _
        Err.Raise mconERR_INVALID_EXPORT_SOURCE, "TextExport::ExportSource", "Invalid export source."
        'query has to be either Select or Union
      Call SysCmd(acSysCmdSetStatus, "Opening source...")
      Set mrsExport = mdbCurrent.OpenRecordset(strQueryName, dbOpenSnapshot)
      Call SysCmd(acSysCmdClearStatus)
    ElseIf Len(strTableName) > 0 Then
      Call SysCmd(acSysCmdSetStatus, "Opening source...")
      Set mrsExport = mdbCurrent.OpenRecordset(strTableName, dbOpenSnapshot)
      Call SysCmd(acSysCmdClearStatus)
    Else
      Err.Raise mconERR_INVALID_EXPORT_SOURCE, "TextExport::ExportSource", "Invalid export source."
    End If
  End If
ElseIf VarType(varSource) >= vbArray Then 'array
  If Not ArrBoundsCheck(varSource) Then _
    Err.Raise mconERR_INVALID_EXPORT_ARRAY, "TextExport::ExportSource", "Invalid export array."
  'make sure it's not an array of objects or array of arrays
  'or something similarly unexportable
  For Each varElement In varSource
    If Not VarTypeCheck(varElement) Then _
      Err.Raise mconERR_INVALID_EXPORT_ARRAY, "TextExport::ExportSource", "Invalid export array."
  Next varElement
  mvarExport = varSource
Else
  Err.Raise mconERR_INVALID_EXPORT_SOURCE, "TextExport::ExportSource", "Invalid export source."
End If

End Property

Public Property Let ExportType(strExportType As String)
'optional, "ASCII" (default) or "WP"
  mstrExportType = strExportType
End Property

Public Property Let FieldDelimiter(strFieldDelimiter As String)
'optional, Tab is default
  mstrFieldDelimiter = strFieldDelimiter
End Property

Public Property Let IncludeFieldNames(blnIncludeFieldNames As Boolean)
'optional, Include is default
'ignored for arrays
  mblnIncludeFieldNames = blnIncludeFieldNames
End Property

Public Property Let NoProgressBar(blnNoProgress As Boolean)
'if used, has to assigned before some other props
  mblnNoProgress = blnNoProgress
End Property

Public Property Get RecordCount() As Long
'number of actually exported records
  RecordCount = mlngExportedCount
End Property

Public Property Let ReplaceWith(strReplaceWith As String)
'optional
'strReplaceWith - will be used to replace mstrRecDelimiter
'and mstrFieldDelimiter (if no text qualifier is used) in the exported data
'default is to replace with one space
  mstrReplaceWith = strReplaceWith
End Property

Public Property Let RecDelimiter(strRecDelimiter As String)
'optional, CrLf is default
  mstrRecDelimiter = strRecDelimiter
End Property

Public Property Let AppendToFile(blnAppend As Boolean)
'optional
'will append to existing export file as opposed to overwriting it
  mblnAppend = blnAppend
End Property

Private Function ReplaceString(ByVal strInString As String, _
        strFindString As String, _
        strReplaceString As String) As String
'This code was originally written by Alden Streeter.
'It is not to be altered or distributed,
'except as part of an application.
'You are free to use it in any application,
'provided the copyright notice is left unchanged.
'
'Code Courtesy of
'Alden Streeter

Dim intPtr As Integer
    If Len(strFindString) > 0 Then  'catch if try to find empty string
        Do
            intPtr = InStr(strInString, strFindString)
            If intPtr > 0 Then
                ReplaceString = ReplaceString & Left$(strInString, intPtr - 1) & strReplaceString
                strInString = Mid$(strInString, intPtr + Len(strFindString))
            End If
        Loop While intPtr > 0
    End If
    ReplaceString = ReplaceString & strInString
End Function

Private Function SysCmd(Arg1 As Variant, Optional Arg2 As Variant, Optional Arg3 As Variant)
'overloads Access.SysCmd() within this module

If Not mblnNoProgress Then
  #If Not VBA5 Then 'use events
    If IsMissing(Arg2) And IsMissing(Arg3) Then 'clear status and progress
      RaiseEvent StatusText(vbNullString)
      RaiseEvent ExportProgress(0)
    ElseIf Not IsMissing(Arg2) And IsMissing(Arg3) Then
      Select Case Arg1
        Case acSysCmdUpdateMeter
          RaiseEvent ExportProgress(CSng(Arg2))
        Case acSysCmdSetStatus
          RaiseEvent StatusText(CStr(Arg2))
      End Select
    ElseIf Not IsMissing(Arg2) And Not IsMissing(Arg3) Then 'init progress
      RaiseEvent StatusText(CStr(Arg2))
      RaiseEvent ExportProgress(0)
    End If
  #ElseIf VBA5 And Access Then 'use Access SysCmd()
    If IsMissing(Arg2) And IsMissing(Arg3) Then
      SysCmd = Access.SysCmd(Arg1)
    ElseIf Not IsMissing(Arg2) And IsMissing(Arg3) Then
      SysCmd = Access.SysCmd(Arg1, Arg2)
    ElseIf Not IsMissing(Arg2) And Not IsMissing(Arg3) Then
      SysCmd = Access.SysCmd(Arg1, Arg2, Arg3)
    End If
  #Else 'no status/progress reported
  #End If
End If

End Function

Private Function Nz(varIn, varValueIfNull) As Variant
'overloads Access Nz() function
'unlike Access, second argument is non-optional

#If Access Then
  Nz = Access.Nz(varIn, varValueIfNull)
#Else
  Select Case True
    Case IsNull(varIn), IsEmpty(varIn)
      Nz = varValueIfNull
    Case Else
      Nz = varIn
  End Select
#End If

End Function

Public Property Let TextQualifier(strTextQualifier As String)
'optional, " is default
  mstrTextQualifier = strTextQualifier
End Property

Private Function ArrBoundsCheck(varExport As Variant) As Boolean
'the array has to be 2-dimensional
On Error Resume Next
Dim varTemp As Variant

varTemp = varExport(LBound(varExport, 1), LBound(varExport, 2))
If Err.Number = 0 Then
  ArrBoundsCheck = True
Else
  Err.Clear
End If

End Function

Private Function VarTypeCheck(varCheck As Variant) As Boolean
'Returns True if varCheck is an array element exportable as text
On Error GoTo 0
Dim intType As Integer

intType = VarType(varCheck)

If intType = vbEmpty Or _
   intType = vbNull Or _
   intType = vbInteger Or _
   intType = vbLong Or _
   intType = vbSingle Or _
   intType = vbDouble Or _
   intType = vbCurrency Or _
   intType = vbDate Or _
   intType = vbString Or _
   intType = vbBoolean Or _
   intType = vbDecimal Or _
   intType = vbByte Then _
   VarTypeCheck = True
   
End Function

Private Function FileExists(strFilename As String) As Boolean
On Error Resume Next
Dim intRes As Integer

intRes = GetAttr(strFilename)
If Err.Number <> 0 Then
  Err.Clear
ElseIf Not (intRes And vbDirectory) > 0 Then
  FileExists = True
End If

End Function

Private Sub Class_Initialize()
On Error GoTo 0

#If Access Then
  Dim ref As Access.Reference
  Dim blnDAOReferenced As Boolean, blnBroken As Boolean
  
  Const cDAOGUID As String = "{00025E01-0000-0000-C000-000000000046}"
  
  mintErrHandling = Application.GetOption("Error Trapping")
  Application.SetOption "Error Trapping", 2
  
  For Each ref In Application.References
    On Error Resume Next
    blnBroken = ref.IsBroken
    If VBA.Err Then blnBroken = True
    On Error GoTo 0
    If ref.Name = "DAO" And ref.Kind = 0 And VBA.StrComp(ref.Guid, cDAOGUID, 1) = 0 And Not blnBroken Then
      blnDAOReferenced = True
      Exit For
    End If
  Next ref
  Set ref = Nothing
  
  If Not blnDAOReferenced Then _
    Err.Raise mconERR_BAD_DAO_REFERENCE, "TextExport::Initialize", "A reference to DAO has to be set."
#End If

'defaults
mstrTextQualifier = VBA.Chr(34)
mstrFieldDelimiter = VBA.vbTab
mstrRecDelimiter = VBA.vbCrLf
mstrReplaceWith = " "
mstrExportType = "ASCII"
mblnIncludeFieldNames = True
mAL.ColumnDimension = 1
mAL.RowDimension = 2

End Sub

Private Sub Class_Terminate()

If Not mrsExport Is Nothing Then
  mrsExport.Close 'either a clone or has been opened in the class
  Set mrsExport = Nothing
End If

If Not mdbCurrent Is Nothing Then Set mdbCurrent = Nothing

Close mintFileNumber

Call SysCmd(acSysCmdClearStatus)

#If Access Then
  Application.SetOption "Error Trapping", mintErrHandling
#End If

End Sub