diff --git a/TheBigOne.cls b/TheBigOne.cls index 1f51785..bbe02d8 100644 --- a/TheBigOne.cls +++ b/TheBigOne.cls @@ -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