Creating Export Specifications Using VBA

[DANCLARK]

I need to automate the exporting of a number of access tables to text files. These tables are created dynamically by make-table queries and consist of several different combinations of fields; therefore I need to use a different export specification in each situation. Can anyone tell me if and how VBA can create new export specifications at run-time?

 

[MHM]

I assume not your export-specifications differ but your tables (diffent field-types, -sizes etc.).

In this case this is always enough:

DoCmd.TransferSpreadsheet acExport, TableNameOrQueryName, ..otherParameters

The TransferSpreadsheet exports no matter how many fields or which fields you need to export. Although it may cause trouble if the built-in export-function does not export into proper formats (like Long instead of Integer, Boolean instead of Integer etc.).

The DoCmd.TransferText - which you probably used - is a lot more difficult; I once had to avoid it totally cause it's that wrong and did it around Write#1... (a lot to do then).

 

[DANCLARK]

Thanks for your reply, but unfortunately I can't use TransferSpreadsheet as the files created need to be plain text files with no formatting information.

In fact, Docmd.TransferText will also work regardless of how many fields need to be exported, if the export specification argument is left blank. However, if it is not given an export specification, it reverts to exporting on a default basis such that the exported file is comma-delimited with a double-quote (") text qualifier, whilst I specifically need to export to a tab-delimited text file with no text qualifier.

I have managed to change the default field delimiter setting to "TabDelimited" by altering the Windows registry, but couldn't find where or how to change the default text qualifier to {None}. Knowing how to do this would also solve the problem, as the only reason I've used export specifications is to set the field delimiter and the text qualifier.

Again - if you or anyone else has any ideas (using eg "Write#1" as mentioned in your post - is that a VB command? I haven't come across it before) I'd be most grateful to receive them...

 

[KDg]

Hi Dan,

the below is an abbreviated version of the code I have run when the database is opened by the first user of the day. You'll need to change the Chr(xx) bits if you just want spaces rather than " and ,
It could also do with being more flexible so that fields and new tables are automatically accounted for, and using a function instead of private vars - but then I don't have to maintain it anymore

HTH

Drew


Private Const strBackPath = "path to write to"
Private rst As Recordset
Private strThisFile As String ' filename to write to
Private g As Double ' pointless position test
Private MyEnd As Integer

Sub BackToText()
Dim t As Integer
Dim a As Integer
Dim dbs As Database
Dim strSQL As String
Dim varH As Variant ' pointless syscmd var
DoCmd.Hourglass True

Set dbs = CurrentDb
Let varH = SysCmd(acSysCmdInitMeter, "Backing Up Data", 4)
For a = 1 To 4
Select Case a
Case Is = 1
Let strSQL = "SELECT * FROM [Employee List]"
Let strThisFile = "Employee List"
Let MyEnd = 19
Case Is = 2
Let strSQL = "SELECT * FROM Compassionate"
Let strThisFile = "Compassionate"
Let MyEnd = 5
Case Is = 3
Let strSQL = "SELECT * FROM [Contact]"
Let strThisFile = "Contact"
Let MyEnd = 5
Case Is = 4
Let strSQL = "SELECT * FROM Headsets"
Let strThisFile = "Headsets"
Let MyEnd = 8

Case Else
MsgBox ("VBA generated error, please close the database and re-run the backup")
Exit Sub

End Select


Set rst = dbs.OpenRecordset(strSQL, 4)




xFileWriter
Let varH = SysCmd(acSysCmdUpdateMeter, a)
Next a

Let varH = SysCmd(acSysCmdClearStatus)
MsgBox ("Data backed up to " & strBackPath & Chr(92))
DoCmd.Hourglass False
End Sub

Sub xFileWriter()

Dim MyFile As Variant
Dim MyString As String
Dim a As Integer
Let MyFile = FreeFile
Open strBackPath & "\" & strThisFile & Left(Now, 2) & Mid(Now, 4, 2) & Mid(Now, 7, 2) & ".csv" For Output Shared As #MyFile
Do Until rst.EOF
For a = 0 To MyEnd
If MyString = "" Then
MyString = Chr(34) & rst.Fields(a).Value & Chr$(34)
Else
Let MyString = MyString & Chr(44) & Chr(34) & rst.Fields(a).Value & Chr$(34)
End If
Next a
Print #MyFile, MyString
Let MyString = Empty
rst.MoveNext
Loop
Close #MyFile
End Sub

 

[DANCLARK]

Many thanks for all help - I've actually found a quick way of doing it - all the parameters for import and export specs are stored in hidden system tables which can be altered using Docmd.RunSQL.

Thanks again for pointers.

 

[Happy YN]

Could you specify how you did this please?
I want the user to be able to specify delimiter and other parameters
Thanks

 

[ISW]

I would like to see someone answer this if possible...

 

[jon_1308]

The hidden table that stores export specifications is "MSysIMEXSpecs" (in Access 2003, anyway).

The following example code demonstrates how to export a table in a defined "special" format. I haven't bothered to clean it up to any great degree, so use at your own risk!

Public Sub ExportTableAsCSV_InSpecialFormat(ByVal TableName As String)
    'Exports the specified table in the current database to the same folder as the current database.
    'The export format is: text, comma-separated, no text qualifier, field names on first row.
 
    'Look for the specified table in the current db.
    Dim TD As TableDef: Set TD = Nothing
    On Error GoTo Err_TblNotExist:
    Set TD = CurrentDb.TableDefs(TableName)
    On Error GoTo 0
    If TD Is Nothing Then GoTo Err_TblNotExist:
 
    'Set full filepath for export
    Dim ExportFilePath As String
    ExportFilePath = Left(CurrentDb.Name, InStrRev(CurrentDb.Name, "\")) & TableName & ".csv"
 
    'Create temporary export specification, for a CSV in a specific format
    Dim TempExportSpec As String
    TempExportSpec = ExportSpec_Add(FieldSeparator:=",", FileType:=1252, TextDelim:="", StartRow:=0)
 
    'Export the table
    DoCmd.SetWarnings False
    DoCmd.TransferText acExportDelim, TempExportSpec, TableName, ExportFilePath
    DoCmd.SetWarnings True
 
    'Delete the temporary export specification
    Call ExportSpec_Delete(TempExportSpec)
 
    Exit Sub
 
Err_TblNotExist:
    Err.Raise 999, , "Table """ & TableName & """ does not exist!"
    Exit Sub
 
End Sub
 
Function ExportSpec_Add( _
                    Optional ByVal DateDelim As String = "/", _
                    Optional ByVal DateFourDigitYear As Boolean = True, _
                    Optional ByVal DateLeadingZeros As Integer = 0, _
                    Optional ByVal DateOrder As Integer = 0, _
                    Optional ByVal DecimalPoint As String = ".", _
                    Optional ByVal FieldSeparator As String = ",", _
                    Optional ByVal FileType As Long = 1252, _
                    Optional ByVal SpecName As String = "", _
                    Optional ByVal SpecType As Integer = 1, _
                    Optional ByVal StartRow As Integer = 0, _
                    Optional ByVal TextDelim As String = "", _
                    Optional ByVal TimeDelim As String = ":") As String
    'Adds an export specification (for use in text file export) to the current
    '   database, with the specified options.
    'Returns the name of the new export specification as a string.
    '   If the SpecName parameter is nonblank then that is the name that will be used.
    '   Otherwise, the specification name will be both random and time-dependent.
 
    'Set the new specification name to use
    Dim SpecName_ToUse As String
    If SpecName = "" Then
        SpecName_ToUse = "TempSpec-" & Format(Now(), "yyyymmddhhmmss") & "-" & Format(CLng(Rnd() * 100000), "000000")
    Else
        SpecName_ToUse = SpecName
    End If
 
    'If other fields are passed as blank strings then change them to Null
    Dim DateDelim_ToUse As String:      DateDelim_ToUse = IIf(DateDelim = "", "Null", """" & DateDelim & """")
    Dim TextDelim_ToUse As String:      TextDelim_ToUse = IIf(TextDelim = "", "Null", """" & TextDelim & """")
    Dim TimeDelim_ToUse As String:      TimeDelim_ToUse = IIf(TimeDelim = "", "Null", """" & TimeDelim & """")
 
    'Add a new specification to the hidden table that stores export specs
    Call DoCmd.SetWarnings(False)
    DoCmd.RunSQL "INSERT INTO MSysIMEXSpecs ( " & _
                    "DateDelim, DateFourDigitYear, DateLeadingZeros, DateOrder, " & _
                    "DecimalPoint, FieldSeparator, FileType, SpecName, SpecType, " & _
                    "StartRow, TextDelim, TimeDelim ) " & vbCrLf & _
                "SELECT " & _
                    DateDelim_ToUse & " AS Expr1, " & _
                    CInt(DateFourDigitYear) & " AS Expr2, " & _
                    DateLeadingZeros & " AS Expr3, " & _
                    DateOrder & " AS Expr4, " & _
                    """" & DecimalPoint & """ AS Expr5, " & _
                    """" & FieldSeparator & """ AS Expr6, " & _
                    FileType & " AS Expr7, " & _
                    """" & SpecName_ToUse & """ AS Expr8, " & _
                    SpecType & " AS Expr9, " & _
                    StartRow & " AS Expr10, " & _
                    TextDelim_ToUse & " AS Expr12, " & _
                    TimeDelim_ToUse & " AS Expr11 " & vbCrLf & _
                "FROM MSysIMEXSpecs;"
    Call DoCmd.SetWarnings(True)
 
    'Set return value
    ExportSpec_Add = SpecName_ToUse
 
End Function
 
Sub ExportSpec_Delete(ByVal ExportSpecName As String)
    'Deletes the named export specification
    Call DoCmd.SetWarnings(False)
    DoCmd.RunSQL "DELETE MSysIMEXSpecs.* FROM MSysIMEXSpecs WHERE SpecName=""" & ExportSpecName & """;"
    Call DoCmd.SetWarnings(True)
End Sub

 

[spikepl]

MS*** tables are at Microsoft's mercy and may differ/change from version to version.

 

[jon_1308]

MS*** tables are at Microsoft's mercy and may differ/change from version to version.

I guessed as much, which is why I specified Access 2003. Still, a partial answer is better than none at all, right?!