add functions to create a text file based on range

This commit is contained in:
Paul Trowbridge 2017-12-08 13:48:01 -05:00
parent 6d6869dc60
commit 4755ebba5b
2 changed files with 60 additions and 2 deletions

7
FL.bas
View File

@ -602,3 +602,10 @@ Sub pivot_field_format()
ActiveSheet.PivotTables("PivotTable1").PivotFields(ActiveCell.value).NumberFormat = "_(* #,##0_);_(* (#,##0);_(* ""-""_);_(@_)" ActiveSheet.PivotTables("PivotTable1").PivotFields(ActiveCell.value).NumberFormat = "_(* #,##0_);_(* (#,##0);_(* ""-""_);_(@_)"
End Sub End Sub
Sub Write_selection()
Call x.FILEp_CreateTXT("C:\Users\ptrowbridge\Documents\hc_ubm\SQL\DB2\DB2 for i\Mass_Trigger\g_trig.sql", x.SHTp_Get(ActiveSheet.Name, Selection.row, Selection.column, False))
End Sub

View File

@ -1665,6 +1665,57 @@ errh:
End Function End Function
Function FILEp_CreateTXT(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)
test_empty = recs(j, i)
wl = recs(j, i)
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_CreateTXT = True
Else
MsgBox (Err.Description)
FILEp_CreateTXT = 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 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 On Error GoTo errflag
@ -1943,7 +1994,7 @@ Function json_concat(list As range) As String
End Function End Function
Public Function ADOp_BuildInsertSQL(ByRef tbl() As String, target As String, trim As Boolean, start As Long, ending As Long, ParamArray ftype()) As String Public Function ADOp_BuildInsertSQL(ByRef tbl() As String, Target As String, trim As Boolean, start As Long, ending As Long, ParamArray ftype()) As String
Dim i As Long Dim i As Long
@ -1951,7 +2002,7 @@ Public Function ADOp_BuildInsertSQL(ByRef tbl() As String, target As String, tri
Dim sql As String Dim sql As String
Dim rec As String Dim rec As String
sql = "INSERT INTO " & target & " VALUES " & vbCrLf sql = "INSERT INTO " & Target & " VALUES " & vbCrLf
For i = start To ending For i = start To ending
rec = "" rec = ""
If i <> start Then sql = sql & "," & vbCrLf If i <> start Then sql = sql & "," & vbCrLf