add csv writer

This commit is contained in:
Paul Trowbridge 2017-07-07 17:40:19 -04:00
parent 51f35f9337
commit e0a7c15cfe

View File

@ -1584,6 +1584,63 @@ Function FILEp_GetTXT(ByRef path As String, approxrecords) As String()
End Function
Function FILEp_CreateCSV(ByRef path As String, ByRef recs() As String) As Boolean
Dim i As Long
Dim j As Long
Dim t() As String
Dim wl As String
Dim test_empty As String
Dim tsf As New ADODB.Stream
On Error GoTo errh
' Dim f As New Scripting.FileSystemObject
' Dim ts As Scripting.TextStream
' Set ts = f.CreateTextFile(path, True, True)
' ts.Close
tsf.Type = 2
tsf.Charset = "utf-8"
tsf.Open
'Set ts = f.OpenTextFile(path, ForReading, False, TristateUseDefault)
i = 0
While i <= UBound(recs, 2)
For j = 0 To UBound(recs, 1)
If j = 0 Then
test_empty = Replace(Replace(recs(j, i), ",", ""), """", "")
wl = """" & Replace(Replace(recs(j, i), ",", ""), """", "") & """"
Else
test_empty = test_empty & Replace(Replace(recs(j, i), ",", ""), """", "")
wl = wl & ",""" & Replace(Replace(recs(j, i), ",", ""), """", "") & """"
End If
Next j
If Len(test_empty) > 0 Then
If i = 0 Then
Call tsf.WriteText(wl)
Else
wl = vbCrLf & wl
Call tsf.WriteText(wl)
End If
End If
i = i + 1
Wend
Call tsf.SaveToFile(path, adSaveCreateOverWrite)
errh:
If Err.Number = 0 Then
FILEp_CreateCSV = True
Else
MsgBox (Err.Description)
FILEp_CreateCSV = False
End If
End Function
Public Function ADOp_Exec(ByRef con As Integer, ByVal sql As String, Optional ApproxSixe As Long, Optional InclHeaders As Boolean, Optional ByVal value As ADOinterface, Optional ConnectTo As String, Optional IntgrtdSec As Boolean, Optional UserName As String, Optional Password As String, Optional textconfigs As String) As Boolean
On Error GoTo errflag