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 acExportDelim" fails 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
沒有留言:
張貼留言