Translate

2013年6月15日 星期六

[VBA] Export Access Table to Text file

https://github.com/walter426/VbaUtilities/blob/master/AccessObjUtilities.bas
20140718:
-Add Quotation field


20130906:
- Fix cannot handle null string in fields
- Fix cannot convert correct Date Time Format

In my experience, "DoCmd.TransferText acExportDelimfails to export table in some cases.
Therefore, I had to write below function to replace the use of previous command.

Code:

'Export Access Table to Text file
Public Function ExportTableToTxt(Tbl_name As String, des As String, Optional Delim As String = " ", Optional Quotation As String = "", Optional HasFldName As Boolean = True, Optional NullStr As String = "", Optional DateFmt As String = "MM/DD/YY", Optional TimeFmt As String = "h:mm") As String
    On Error GoTo Err_ExportTableToTxt
    
    Dim FailedReason As String
    
    If des = "" Or Tbl_name = "" Then
        FailedReason = "Input is invalid"
        GoTo Exit_ExportTableToTxt
    End If
    
    If TableExist(Tbl_name) = False Then
        FailedReason = Tbl_name & " does not exist"
        GoTo Exit_ExportTableToTxt
    End If
    
    If Delim = "" Then
        Delim = " "
    End If

    
    Dim des_PortNum As Integer
    des_PortNum = FreeFile

    Open des For Output As #des_PortNum

    With CurrentDb
        Dim line As String
        line = ""
    
        If HasFldName = True Then
            Dim TD_Tbl As TableDef
            Set TD_Tbl = .TableDefs(Tbl_name)
            
            Dim fld As Field
            
            For Each fld In TD_Tbl.Fields
                line = line & fld.Name & Delim
            Next
            
            line = Left(line, Len(line) - Len(Delim))
            Print #des_PortNum, line
        End If
        
        
        Dim RS_Tbl As Recordset
        Set RS_Tbl = .OpenRecordset(Tbl_name)
        
        With RS_Tbl
            .MoveFirst
        
            Dim FldIdx As Integer
            Dim fld_str As String
            
            Do Until .EOF
                FldIdx = 0
                line = ""
                
                For FldIdx = 0 To .Fields.count - 1
                    If IsNull(.Fields(FldIdx)) = True Then
                        fld_str = NullStr
                    
                    ElseIf .Fields(FldIdx).Type = dbDate Then
                        If .Fields(FldIdx).Value > 1 Then
                            fld_str = Format(str(.Fields(FldIdx).Value), DateFmt)
                        Else
                            fld_str = Format(str(.Fields(FldIdx).Value), TimeFmt)
                        End If
                        
                    Else
                        fld_str = .Fields(FldIdx).Value
                        
                    End If
                    
                    
                    line = line & Quotation & fld_str & Quotation & Delim
                    
                Next
                
                line = Left(line, Len(line) - Len(Delim))
                Print #des_PortNum, line
                
                .MoveNext
                
            Loop
            
        End With 'RS_Tbl
        
        .Close
        
    End With 'CurrentDb
    
    Close #des_PortNum


Exit_ExportTableToTxt:
    ExportTableToTxt = FailedReason
    Exit Function

Err_ExportTableToTxt:
    FailedReason = Err.Description
    Resume Exit_ExportTableToTxt
        
End Function

沒有留言:

張貼留言