export number field to text file

[RPW1]

i need to export number field 2 decimal places from a query as #####.## and it can't have quotation marks in result, to delimited text file it keeps dropping the ending zeros. New writing code. Any Suggestions. Thanks!

 

[JerryKlmns]

SELECT Format([yourField], "#,##0.00")
FROM yourTable

 

[Remou]

I find that in my version of Access formated numbers output to a delimited file end up with quotes. It's one of those days, so this *may* be overkill.

Option Compare Database
Option Explicit

Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" _
        (lpvDest As Any, lpvSource As Any, ByVal cbCopy As Long)

Type OBJECTHEADER
    Signature As Integer
    HeaderSize As Integer
    ObjectType As Long
    NameLen As Integer
    ClassLen As Integer
    NameOffset As Integer
    ObjectSize As PT
    OleInfo As String * 256
End Type

Function OLEFieldType(fldField As DAO.Field) As String
'**** EXPERIMENTAL ****
'Modified From: [URL unfurl="true"]http://support.microsoft.com/kb/175261[/URL]

Dim Arr() As Byte
Dim ObjHeader As OBJECTHEADER
Dim Buffer As String
Dim ObjectOffset As Long
Dim i As Long


    'Seems to be enough
    Arr() = fldField.GetChunk(0, 100)

    'Copy the first 19 bytes into a variable of the
    ' defined type OBJECTHEADER
    CopyMemory ObjHeader, Arr(0), 19

    'Determine where the header ends
    ObjectOffset = ObjHeader.HeaderSize + 1
    
    '30 seems to be enough
    Buffer = ""

    For i = ObjectOffset To ObjectOffset + 30
        If Arr(i) > 32 And Arr(i) < 130 Then Buffer = Buffer & Chr(Arr(i))
    Next i

    OLEFieldType = Buffer
    
End Function


Function ExportDelimited(TableOrQuery As String, _
                    Optional OutputFile As String, _
                    Optional Header As Boolean = True, _
                    Optional Preview As Boolean = False, _
                    Optional Delim As String = ",", _
                    Optional Quotes As String = """", _
                    Optional Decimals As Integer = 2, _
                    Optional StripMemo As Boolean = True, _
                    Optional YesNoType As String = "Yes/No") As Boolean

'Format for Boolean="Yes/No","True/False","0"
'where 0 means that the field will be output as a number.

Dim intFNo As Integer
Dim i As Integer
Dim intStyle As Integer
Dim rs As DAO.Recordset
Dim strMessage As String
Dim strData As String
Dim strField As String
Dim strDec As String

On Error GoTo HandleError

'Assume fail
ExportDelimited = False

'No export table or query
If TableOrQuery = "" Then
    MsgBox "Nothing to process."
    Exit Function
End If

'1 = Table; 5 = Query; 6 = Attached Table
If IsNull(DLookup("Name", "MSysObjects", "Name='" & TableOrQuery _
        & "' And Type In (1,5,6)")) Then
    MsgBox "Cannot find table or query in this database."
    Exit Function
End If

'No output file
If Trim(OutputFile & "") = "" Then
    OutputFile = CurrentProject.Path & "\" & TableOrQuery & ".txt"
    If Dir(OutputFile) <> "" Then
        strMessage = "Output to: " & vbCrLf & OutputFile & vbCrLf & vbCrLf _
             & "This file exists and will be overwritten." & vbCrLf & "Continue?"
        intStyle = vbYesNo + vbCritical
    Else
        strMessage = "Output to: " & vbCrLf & OutputFile & vbCrLf & vbCrLf _
                     & "Continue?"
        intStyle = vbYesNo + vbQuestion
    End If
    
    If MsgBox(strMessage, intStyle) = vbNo Then
        Exit Function
    End If
End If

'Decimals
If Decimals > 0 Then
    strDec = "#0."
    For i = 1 To Decimals
        strDec = strDec & "0"
    Next
Else
    strDec = "#0"
End If

'Setup
Set rs = CurrentDb.OpenRecordset(TableOrQuery)

intFNo = FreeFile
Open OutputFile For Output As intFNo

'Header record
If Header Then
    strData = ""
    For i = 0 To rs.Fields.Count - 1
        strData = strData & Delim & Quotes & rs.Fields(i).Name & Quotes
    Next
    Print #intFNo, Mid(strData, 2)
End If

Do While Not rs.EOF
    strData = ""
    strField = ""
    For i = 0 To rs.Fields.Count - 1
        Select Case rs.Fields(i).Type
            Case dbBoolean '1=YesNo
                If YesNoType = "0" Then
                    strField = rs.Fields(i)
                Else
                    strField = Quotes & Format(rs.Fields(i), YesNoType) & Quotes
                End If
            Case dbByte         '2=Byte
                strField = rs.Fields(i)
            Case dbCurrency     '5=Currency
                strField = Format(rs.Fields(i), strDec)
            Case dbDate         '8=DateTime
                strField = rs.Fields(i)
            Case dbDouble       '7=Double
                strField = Format(rs.Fields(i), strDec)
            Case dbInteger      '3=Integer
                strField = rs.Fields(i)
            Case dbLong         '4=Long Integer
                strField = rs.Fields(i)
            Case dbMemo         '12=Memo
                If (rs.Fields(i).Attributes And dbHyperlinkField) = 0& Then
                    'Memo
                    If StripMemo Then
                        If Trim(rs.Fields(i) & "") = "" Then
                            strField = ""
                        Else
                            strField = Quotes & Replace(rs.Fields(i), vbCrLf, " ") & Quotes
                        End If
                    Else
                        strField = Quotes & rs.Fields(i) & Quotes
                    End If
                Else
                    'Hyperlink
                    strField = Quotes & rs.Fields(i) & Quotes
                End If
            Case dbLongBinary       '11=OLE Object
                'Experimental
                If Not IsNull(rs.Fields(i)) Then
                    strField = Quotes & OLEFieldType(rs.Fields(i)) & Quotes
                Else
                    strField = ""
                End If
            Case dbSingle           '6=Single
                strField = Format(rs.Fields(i), strDec)
            Case dbText             '10=Text
                strField = Quotes & rs.Fields(i) & Quotes
        End Select
        strData = strData & Delim & strField
    Next
    Print #intFNo, Mid(strData, 2)
    rs.MoveNext
Loop

rs.Close
Set rs = Nothing
Close intFNo
ExportDelimited = True

If Preview Then
    FollowHyperlink OutputFile
End If

ExitHere:
    Exit Function
    
HandleError:
    MsgBox Err.Number & ": " & Err.message
    Err.Clear
    Close intFNo
    Resume ExitHere
    
    
End Function