-
Added a constant field
hi everyone, i finally got the code below to work with my text file and database but i was wandering if there is a way to add a constant value to an extra constant field to all entries made by this import, like right now all text files added have three fields and the code places them in the right place but i would like to add another field to the import , like field4 = "1" how would i do this
many thanks
code is listed below
CODE
Public Function ImportTextFile(cn As Object, _
ByVal tblName As String, FileFullPath As String, _
Optional FieldDelimiter As String = ",", _
Optional RecordDelimiter As String = vbCrLf) As Boolean
Dim cmd As New adodb.Command
Dim rs As New adodb.Recordset
Dim sFileContents As String
Dim iFileNum As Integer
Dim sTableSplit() As String
Dim sRecordSplit() As String
Dim lCtr As Integer
Dim iCtr As Integer
Dim iFieldCtr As Integer
Dim lRecordCount As Long
Dim iFieldsToImport As Integer
'These variables prevent having to requery a recordset for each record
Dim asFieldNames() As String
Dim abFieldIsString() As Boolean
Dim iFieldCount As Integer
Dim sSQL As String
Dim bQuote As Boolean
'On Error GoTo errHandler
If Not TypeOf cn Is adodb.Connection Then Exit Function
If Dir(FileFullPath) = "" Then Exit Function
If cn.State = 0 Then cn.Open
Set cmd.ActiveConnection = cn
cmd.CommandText = tblName
cmd.CommandType = adCmdTable
Set rs = cmd.Execute
iFieldCount = rs.Fields.Count
rs.Close
ReDim asFieldNames(iFieldCount - 1) As String
ReDim abFieldIsString(iFieldCount - 1) As Boolean
For iCtr = 0 To iFieldCount - 1
asFieldNames(iCtr) = "[" & rs.Fields(iCtr).Name & "]"
abFieldIsString(iCtr) = FieldIsString(rs.Fields(iCtr))
Next
iFileNum = FreeFile
Open FileFullPath For Input As #iFileNum
sFileContents = Input(LOF(iFileNum), #iFileNum)
Close #iFileNum
'split file contents into rows
sTableSplit = Split(sFileContents, RecordDelimiter)
lRecordCount = UBound(sTableSplit)
'make it "all or nothing: whole text
'file or none of it
cn.BeginTrans
For lCtr = 0 To lRecordCount - 1
'split record into field values
sRecordSplit = Split(sTableSplit(lCtr), FieldDelimiter)
iFieldsToImport = IIf(UBound(sRecordSplit) + 1 < _
iFieldCount, UBound(sRecordSplit) + 1, iFieldCount)
'construct sql
sSQL = "INSERT INTO " & tblName & " ) "
For iCtr = 0 To iFieldsToImport - 1
bQuote = abFieldIsString(iCtr)
sSQL = sSQL & asFieldNames(iCtr)
If iCtr < iFieldsToImport - 1 Then sSQL = sSQL & ","
Next iCtr
sSQL = sSQL & ") VALUES ("
For iCtr = 0 To iFieldsToImport - 1
If abFieldIsString(iCtr) Then
sSQL = sSQL & prepStringForSQL(sRecordSplit(iCtr))
Else
sSQL = sSQL & sRecordSplit(iCtr)
End If
If iCtr < iFieldsToImport - 1 Then sSQL = sSQL & ","
Next iCtr
sSQL = sSQL & ")"
cn.Execute sSQL
Next lCtr
cn.CommitTrans
rs.Close
Close #iFileNum
Set rs = Nothing
Set cmd = Nothing
ImportTextFile = True
Exit Function
errHandler:
On Error Resume Next
If cn.State <> 0 Then cn.RollbackTrans
If iFileNum > 0 Then Close #iFileNum
If rs.State <> 0 Then rs.Close
Set rs = Nothing
Set cmd = Nothing
End Function
Private Function FieldIsString(FieldObject As adodb.Field) _
As Boolean
Select Case FieldObject.Type
Case adBSTR, adChar, adVarChar, adWChar, adVarWChar, _
adLongVarChar, adLongVarWChar
FieldIsString = True
Case Else
FieldIsString = False
End Select
End Function
Private Function prepStringForSQL(ByVal sValue As String) _
As String
Dim sAns As String
sAns = replace(sValue, Chr(39), "''")
sAns = "'" & sAns & "'"
prepStringForSQL = sAns
End Function
Private Sub Command3_Click()
Dim cn As New adodb.Connection
cn.ConnectionString = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=C:\pcc\data\db1.mdb"
cn.Open
ImportTextFile cn, "table1", "C:\pcc\output\kodak.txt"
cmd.Execute
End Sub
END CODE
Similar Threads
-
By David Hirschfeld in forum ASP.NET
Replies: 0
Last Post: 01-05-2003, 12:49 PM
-
By Brian Higgins in forum VB Classic
Replies: 0
Last Post: 11-27-2001, 08:33 AM
-
By David K. in forum Careers
Replies: 0
Last Post: 01-15-2001, 10:21 PM
-
By Georgiana Trigg in forum VB Classic
Replies: 0
Last Post: 10-29-2000, 12:21 PM
-
By David K. in forum Careers
Replies: 0
Last Post: 10-06-2000, 05:29 PM
Posting Permissions
- You may not post new threads
- You may not post replies
- You may not post attachments
- You may not edit your posts
-
Forum Rules
|
Development Centers
-- Android Development Center
-- Cloud Development Project Center
-- HTML5 Development Center
-- Windows Mobile Development Center
|