[COLOR=green]
'' textstream question thread705-1070834
'' [URL unfurl="true"]http://www.tek-tips.com/viewthread.cfm?qid=1070834[/URL]
''
'' **************************************************************************
'' Returns the nth word in a specific field.
''
'' ACC2000: How to Parse Comma-Separated Text into Multiple Fields (Method 2)
'' [URL unfurl="true"]http://support.microsoft.com/default.aspx?scid=kb;en-us;210588[/URL]
'' <modified>
'' **************************************************************************
'' [/color]
[COLOR=blue]Function[/color] fncNthField([COLOR=blue]ByVal[/color] s, intIndx [COLOR=blue]As Integer[/color])
[COLOR=blue]Dim[/color] intCount [COLOR=blue]As Integer[/color]
[COLOR=blue]Dim[/color] intStartPos [COLOR=blue]As Integer[/color], intEndPos [COLOR=blue]As Integer[/color]
intCount = 1
intStartPos = 1
[COLOR=blue]For[/color] intCount = 2 [COLOR=blue]To[/color] intIndx
intStartPos = InStr(intStartPos, s, Chr(9)) + 1
[COLOR=blue]Next[/color] intCount
intEndPos = InStr(intStartPos, s, Chr(9)) - 1
[COLOR=blue]If[/color] intEndPos <= 0 [COLOR=blue]Then[/color] intEndPos = Len(s)
fncNthField = Trim(Mid(s, intStartPos, intEndPos - intStartPos + 1))
[COLOR=blue]End Function[/color]
[COLOR=green]'' *******************************************************************
'' 1. Import tab delimited *.txt file into Access table
'' ----------------------------------------------------
'' References:
''
'' Microsoft DAO 3.6 Object Library,
'' Microsoft Scripting Runtime
'' *******************************************************************
'' [/color]
[COLOR=blue]Sub[/color] ReadTxtTab()
On Error GoTo Err_ReadTxtTab
[COLOR=blue]Dim[/color] rst [COLOR=blue]As[/color] DAO.Recordset
[COLOR=blue]Dim[/color] fs [COLOR=blue]As[/color] FileSystemObject, f [COLOR=blue]As [/color] TextStream,
fn [COLOR=blue]As [/color] File
[COLOR=blue]Dim[/color] strDir [COLOR=blue]As String[/color], strFile [COLOR=blue]As String[/color]
[COLOR=blue]Dim[/color] strLine [COLOR=blue]As String[/color]
[COLOR=blue]Dim[/color] intLineNo [COLOR=blue]As Integer[/color]
[COLOR=blue]Dim[/color] str1 [COLOR=blue]As String[/color], str2 [COLOR=blue]As String[/color], str3 [COLOR=blue]As String[/color], str4 [COLOR=blue]As String[/color]
strDir = "D:\Default_Access\" [COLOR=green]'' Location of *.txt file[/color]
strFile = "TestTxtTab.txt" [COLOR=green]'' Name of *.txt file[/color]
[COLOR=blue]Set[/color] fs = CreateObject("Scripting.FileSystemObject")
[COLOR=blue]Set[/color] fn = fs.GetFile(strDir & strFile)
[COLOR=blue]Set[/color] f = fn.OpenAsTextStream(ForReading, TristateFalse)
[COLOR=blue]Set[/color] rst = CurrentDb.OpenRecordset("tblImportTxtTab")
[COLOR=green]'' Skip 1st line (1st line contains field names) [/color]
f.SkipLine
[COLOR=blue]Do While[/color] f.AtEndOfStream <> [COLOR=blue]True[/color]
[COLOR=green]
'' To remove " {=Chr(34)} from text values
'strLine = Trim(Replace(f.ReadLine, Chr34), ""))
[/color]
strLine = Trim(f.ReadLine)
intLineNo = f.Line
str1 = fncNthField(strLine, 1)
str2 = fncNthField(strLine, 2)
str3 = fncNthField(strLine, 3)
str4 = fncNthField(strLine, 4)
rst.AddNew
rst!Fld1 = str1
rst!Fld2 = str2
rst!Fld3 = str3
rst!Fld4 = str4
rst.Update
[COLOR=blue]Loop[/color]
Exit_ReadTxtTab:
rst.Close
[COLOR=blue]Set[/color] rst = [COLOR=blue]Nothing[/color]
[COLOR=blue]Set[/color] fs = [COLOR=blue]Nothing[/color]
[COLOR=blue]Set[/color] fn = [COLOR=blue]Nothing[/color]
[COLOR=blue]Set[/color] f = [COLOR=blue]Nothing[/color]
Exit [COLOR=blue]Sub[/color]
Err_ReadTxtTab:
[COLOR=green]
'' Modify this section according to your needs, some errors may be prevented by altering the
'' string expression.
''
'' tblImportTxtTab.FldX, Allow Zero Length = No
'' Err.Number: 3315
'' Err.Description: "Field 'tblImportTxtTab.FldX'cannot be a zero-length string."
[/color]
[COLOR=blue]If[/color] Err.Number = 3315[COLOR=blue]Then[/color]
[COLOR=blue]Debug.Print[/color] intLineNo, Err.Description: [COLOR=blue]Resume Next[/color]
[COLOR=green]
'' tblImportTxtTab.FldX = Primary Key
'' Err.Number: 3022
'' Err.Description: "The changes you requested to the table were not successful
'' because they would create duplicate values in the index, primary key, or relationship.
'' Change the data in the field or fields that contain duplicate data, remove the index,
'' or redefine the index to permit duplicate entries and try again."
[/color ]
[COLOR=blue]ElseIf[/color] Err.Number = 3022[COLOR=blue]Then[/color ]
[COLOR=blue]Debug.Print[/color] intLineNo, Err.Number: [COLOR=blue]Resume Next[/color]
[COLOR=green]'' All other errors: [/color]
[COLOR=blue]Else[/color]
[COLOR=green]'' Proceed or Exit? [/color]
[COLOR=blue]If[/color] MsgBox(Err.Number & vbCrLf & vbCrLf & Err.Description & vbCrLf & vbCrLf _
& "Click OK to continue, Cancel to exit " _
, vbOKCancel, "Procedure Error: ReadTxtTab") = vbCancel [COLOR=blue]Then[/color]
[COLOR=blue]Resume[/color] Exit_ReadTxtTab
[COLOR=blue]Else[/color]
[COLOR=blue]Resume Next[/color]
[COLOR=blue]End If[/color]
[COLOR=blue]End If[/color]
[COLOR=blue]End Sub[/color]
