Import text file

  • Thread starter Thread starter Guest
  • Start date Start date
G

Guest

Hello:

I am trying to import text delimited file produced by external system.
This file contains data starting from row 10, first 9 rows contain some
tiltes and blank lines. If I remove first 9 rows, my import works perfectly.

How can I have data imported from that file starting at row 10? I don't
want users to edit that file manually.

I would appreciate your assistance or thoughts?
 
Two approaches:

(1) Open the text file in VBA code, read the first 9 rows and ignore them,
then open a new text file and write each row (beginning with the 10th row)
from the first file into the second file. Close both files, and then import
the second file.

(2) Open a recordset to the table where the data are to go. Open the text
file in VBA code, and read each row from the file. Do nothing with the first
9 rows, and on the 10th row, write the data from the row into the recordset
as a new record. Continue until all data have been imported.
 
(1) Open the text file in VBA code, read the first 9 rows and ignore them,
then open a new text file and write each row (beginning with the 10th row)
from the first file into the second file. Close both files, and then import
the second file.
Click to expand...

Here's a VBA function to trim the first lines from a text file:

Function TrimFileHeader( _
ByVal FileSpec As String, _
ByVal LinesToTrim As Long, _
Optional ByVal BackupExtension As String = "") As Long

'Removes the specified number of lines from the beginning
'of a textfile.
'Optionally leaves the original file with its extension
'changed to BackupExtension.
'Returns 0 on success, otherwise the number of the error.

Dim fso As Object 'Scripting.FileSystemObject
Dim fIn As Object 'Scripting.TextStream
Dim fOut As Object 'Scripting.TextStream
Dim fFile As Object 'Scripting.File
Dim strFolder As String
Dim strNewFile As String
Dim strBakFile As String
Dim j As Long

On Error GoTo Err_TrimFileHeader

Set fso = CreateObject("Scripting.FileSystemObject")

With fso
'Handle relative path in Filespec
FileSpec = .GetAbsolutePathName(FileSpec)
strFolder = .GetParentFolderName(FileSpec)
strNewFile = .BuildPath(strFolder, fso.GetTempName)
'Open files
Set fIn = .OpenTextFile(FileSpec, ForReading)
Set fOut = .CreateTextFile(strNewFile, True)

'Dump header
For j = 1 To LinesToTrim
fIn.ReadLine
Next

'Read and write remainder of file
Do While Not fIn.AtEndOfStream
fOut.WriteLine fIn.ReadLine
Loop

fOut.Close
fIn.Close

'Rename or delete old file
If Len(BackupExtension) > 0 Then
strBakFile = .GetBaseName(FileSpec) _
& IIf(Left(BackupExtension, 1) <> ".", ".", "") _
& BackupExtension
If .FileExists(.BuildPath(strFolder, strBakFile)) Then
.DeleteFile .BuildPath(strFolder, strBakFile), True
End If
Set fFile = .GetFile(FileSpec)
fFile.Name = strBakFile
Set fFile = Nothing
Else
.DeleteFile FileSpec, True
End If

'Rename new file
Set fFile = .GetFile(strNewFile)
fFile.Name = .GetFileName(FileSpec)
Set fFile = Nothing
Set fso = Nothing

End With
'normal exit
TrimFileHeader = 0
Exit Function
Err_TrimFileHeader:
TrimFileHeader = Err.Number
End Function
 
I'm new to Access. How do I run this code? I have four lines I want to cut
off a text file that I have.

Do I create a macro, with an action run code, and put in
TrimFileHeader("filename of file", 4)? I tried that and nothing happened.

Thanks in advance,

Nick
 
The function was written to be called from VBA rather than from a macro,
but it worked just fine using the RunCode macro action in my test
database with this argument for the Function Name:

TrimFileHeader("C:\TEMP\minlhe.txt",1)

To find out what's happening, use the MsgBox macro action with something
like this as the Message argument:

="TrimFileHeader: " &
Error(TrimFileHeader("C:\folder\subfolder\filename.txt",4,"bak"))

but using the actual location and name of your file. When you run the
macro it will display just "TrimFileHeader:" if the function ran
successfully, or else an error message (e.g. "TrimFileHeader: File Not
Found"). The "bak" argument keeps a copy of the original file.
 
John - Thanks for the reply but I found the problem: I didn't have the
Microsoft Scripting Runtime library enabled. After enabling that under
references, the code worked great! Thanks.
 
Mine just don't work.. I really got confused.
Could you please help me to take a look? I use a form to perform the file
import..

Great thanks !!

---------------------------------------------------
Private Sub Command0_Click()

Dim stDocName As String

stDocName = "C:\SVM220.txt"

strSQL = "delete * from SVM200_Table"
CurrentDb.Execute strSQL, dbfailonerror

If TrimFileHeader(stDocName, 7) = 0 Then
DoCmd.TransferText acImportFixed, "svm220", "SVM200_Table", stDocName

End If
End Sub
----------------------------------------

Function TrimFileHeader( _
ByVal FileSpec As String, _
ByVal LinesToTrim As Long, _
Optional ByVal BackupExtension As String = "") As Long

........

End function
 
Change the procedure to make it easier to discover the return value from
TrimFileHeader (e.g. as below). Then set a breakpoint on the
lngRetVal = ....
line and step through the remaining lines to see just what's happening.

Private Sub Command0_Click()

Dim stDocName As String
Dim lngRetVal As Long

stDocName = "C:\SVM220.txt"

strSQL = "delete * from SVM200_Table"
CurrentDb.Execute strSQL, dbfailonerror

lngRetVal = TrimFileHeader(stDocName, 7)
If lngRetVal = 0 Then
DoCmd.TransferText acImportFixed, "svm220", _
"SVM200_Table", stDocName
Else
MsgBox "TrimFileHeader reported error " _
& lngRetVal & ": " & Error(lngRetVal), _
vbExclamation + vbOKOnly
End If
End Sub
 
Thanks.. I modified the code, and got the error message:

"TrimFileHeader reported error 5: Invalid procedure call or argument "

Let me just copy the full code here, and you might help me out to see if I
got anything wrong.. I am really confused..

Thanks a lot!


---------------------------

Private Sub Command0_Click()

Dim stDocName As String
Dim lngRetVal As Long

stDocName = "C:\SVM220.txt"

strSQL = "delete * from SVM200_Table"
CurrentDb.Execute strSQL, dbfailonerror

lngRetVal = TrimFileHeader(stDocName, 7)
If lngRetVal = 0 Then
DoCmd.TransferText acImportFixed, "svm220", _
"SVM200_Table", stDocName
Else
MsgBox "TrimFileHeader reported error " _
& lngRetVal & ": " & Error(lngRetVal), _
vbExclamation + vbOKOnly
End If
End Sub


Function TrimFileHeader( _
ByVal FileSpec As String, _
ByVal LinesToTrim As Long, _
Optional ByVal BackupExtension As String = "") As Long

'Removes the specified number of lines from the beginning
'of a textfile.
'Optionally leaves the original file with its extension
'changed to BackupExtension.
'Returns 0 on success, otherwise the number of the error.

Dim fso As Object 'Scripting.FileSystemObject
Dim fIn As Object 'Scripting.TextStream
Dim fOut As Object 'Scripting.TextStream
Dim fFile As Object 'Scripting.File
Dim strFolder As String
Dim strNewFile As String
Dim strBakFile As String
Dim j As Long

On Error GoTo Err_TrimFileHeader

Set fso = CreateObject("Scripting.FileSystemObject")

With fso
'Handle relative path in Filespec
FileSpec = .GetAbsolutePathName(FileSpec)
strFolder = .GetParentFolderName(FileSpec)
strNewFile = .BuildPath(strFolder, fso.GetTempName)
'Open files
Set fIn = .OpenTextFile(FileSpec, ForReading)
Set fOut = .CreateTextFile(strNewFile, True)

'Dump header
For j = 1 To LinesToTrim
fIn.ReadLine
Next

'Read and write remainder of file
Do While Not fIn.AtEndOfStream
fOut.WriteLine fIn.ReadLine
Loop

fOut.Close
fIn.Close

'Rename or delete old file
If Len(BackupExtension) > 0 Then
strBakFile = .GetBaseName(FileSpec) _
& IIf(Left(BackupExtension, 1) <> ".", ".", "") _
& BackupExtension
If .FileExists(.BuildPath(strFolder, strBakFile)) Then
.DeleteFile .BuildPath(strFolder, strBakFile), True
End If
Set fFile = .GetFile(FileSpec)
fFile.Name = strBakFile
Set fFile = Nothing
Else
.DeleteFile FileSpec, True
End If

'Rename new file
Set fFile = .GetFile(strNewFile)
fFile.Name = .GetFileName(FileSpec)
Set fFile = Nothing
Set fso = Nothing

End With
'normal exit
TrimFileHeader = 0
Exit Function
Err_TrimFileHeader:
TrimFileHeader = Err.Number
End Function
----------------------------------
 
So far I haven't been able to make TrimFileHeader produce error 5, so we
need to learn more about how it's happening on your system. Start by
disabling the error handling in TrimFileHeader() by commenting out this
line:

On Error GoTo Err_TrimFileHeader

Then, in your Click event procedure, set a breakpoint on this line:

lngRetVal = TrimFileHeader(stDocName, 7)

Click the button to launch the procedure, and then step through the code
line by line (using F8 or the Step Into toolbar button). Which line of
code produces the error?
 
I am trying to use this code but it is not working for me
I get no error but the code creates a new file with a random name (ie rad24863.tmp), which is the modified file, while the original file remains unchanged.
I need for the original file to be modified with the deleted header rows.

I would appreciate any help.

Shazam


John Nurick said:
So far I haven't been able to make TrimFileHeader produce error 5, so we
need to learn more about how it's happening on your system. Start by
disabling the error handling in TrimFileHeader() by commenting out this
line:

On Error GoTo Err_TrimFileHeader

Then, in your Click event procedure, set a breakpoint on this line:

lngRetVal = TrimFileHeader(stDocName, 7)

Click the button to launch the procedure, and then step through the code
line by line (using F8 or the Step Into toolbar button). Which line of
code produces the error?

On Thu, 17 Aug 2006 08:01:01 -0700, Landson
<[email protected]> wrote:

>
>Thanks.. I modified the code, and got the error message:
>
>"TrimFileHeader reported error 5: Invalid procedure call or argument "
>
>Let me just copy the full code here, and you might help me out to see if I
>got anything wrong.. I am really confused..
>
>Thanks a lot!
>
>
>---------------------------
>
>Private Sub Command0_Click()
>
> Dim stDocName As String
> Dim lngRetVal As Long
>
> stDocName = "C:\SVM220.txt"
>
> strSQL = "delete * from SVM200_Table"
> CurrentDb.Execute strSQL, dbfailonerror
>
> lngRetVal = TrimFileHeader(stDocName, 7)
> If lngRetVal = 0 Then
> DoCmd.TransferText acImportFixed, "svm220", _
> "SVM200_Table", stDocName
> Else
> MsgBox "TrimFileHeader reported error " _
> & lngRetVal & ": " & Error(lngRetVal), _
> vbExclamation + vbOKOnly
> End If
>End Sub
>
>
>Function TrimFileHeader( _
> ByVal FileSpec As String, _
> ByVal LinesToTrim As Long, _
> Optional ByVal BackupExtension As String = "") As Long
>
> 'Removes the specified number of lines from the beginning
> 'of a textfile.
> 'Optionally leaves the original file with its extension
> 'changed to BackupExtension.
> 'Returns 0 on success, otherwise the number of the error.
>
> Dim fso As Object 'Scripting.FileSystemObject
> Dim fIn As Object 'Scripting.TextStream
> Dim fOut As Object 'Scripting.TextStream
> Dim fFile As Object 'Scripting.File
> Dim strFolder As String
> Dim strNewFile As String
> Dim strBakFile As String
> Dim j As Long
>
> On Error GoTo Err_TrimFileHeader
>
> Set fso = CreateObject("Scripting.FileSystemObject")
>
> With fso
> 'Handle relative path in Filespec
> FileSpec = .GetAbsolutePathName(FileSpec)
> strFolder = .GetParentFolderName(FileSpec)
> strNewFile = .BuildPath(strFolder, fso.GetTempName)
> 'Open files
> Set fIn = .OpenTextFile(FileSpec, ForReading)
> Set fOut = .CreateTextFile(strNewFile, True)
>
> 'Dump header
> For j = 1 To LinesToTrim
> fIn.ReadLine
> Next
>
> 'Read and write remainder of file
> Do While Not fIn.AtEndOfStream
> fOut.WriteLine fIn.ReadLine
> Loop
>
> fOut.Close
> fIn.Close
>
> 'Rename or delete old file
> If Len(BackupExtension) > 0 Then
> strBakFile = .GetBaseName(FileSpec) _
> & IIf(Left(BackupExtension, 1) <> ".", ".", "") _
> & BackupExtension
> If .FileExists(.BuildPath(strFolder, strBakFile)) Then
> .DeleteFile .BuildPath(strFolder, strBakFile), True
> End If
> Set fFile = .GetFile(FileSpec)
> fFile.Name = strBakFile
> Set fFile = Nothing
> Else
> .DeleteFile FileSpec, True
> End If
>
> 'Rename new file
> Set fFile = .GetFile(strNewFile)
> fFile.Name = .GetFileName(FileSpec)
> Set fFile = Nothing
> Set fso = Nothing
>
> End With
> 'normal exit
> TrimFileHeader = 0
> Exit Function
>Err_TrimFileHeader:
> TrimFileHeader = Err.Number
>End Function
>----------------------------------
>
>
>
>
>
>
>"John Nurick" wrote:
>
>> Change the procedure to make it easier to discover the return value from
>> TrimFileHeader (e.g. as below). Then set a breakpoint on the
>> lngRetVal = ....
>> line and step through the remaining lines to see just what's happening.
>>
>> Private Sub Command0_Click()
>>
>> Dim stDocName As String
>> Dim lngRetVal As Long
>>
>> stDocName = "C:\SVM220.txt"
>>
>> strSQL = "delete * from SVM200_Table"
>> CurrentDb.Execute strSQL, dbfailonerror
>>
>> lngRetVal = TrimFileHeader(stDocName, 7)
>> If lngRetVal = 0 Then
>> DoCmd.TransferText acImportFixed, "svm220", _
>> "SVM200_Table", stDocName
>> Else
>> MsgBox "TrimFileHeader reported error " _
>> & lngRetVal & ": " & Error(lngRetVal), _
>> vbExclamation + vbOKOnly
>> End If
>> End Sub
>>
>>
>> On Wed, 16 Aug 2006 10:33:02 -0700, landson
>> <[email protected]> wrote:
>>
>> >Mine just don't work.. I really got confused.
>> >Could you please help me to take a look? I use a form to perform the file
>> >import..
>> >
>> >Great thanks !!
>> >
>> >---------------------------------------------------
>> >Private Sub Command0_Click()
>> >
>> > Dim stDocName As String
>> >
>> > stDocName = "C:\SVM220.txt"
>> >
>> > strSQL = "delete * from SVM200_Table"
>> > CurrentDb.Execute strSQL, dbfailonerror
>> >
>> > If TrimFileHeader(stDocName, 7) = 0 Then
>> > DoCmd.TransferText acImportFixed, "svm220", "SVM200_Table", stDocName
>> >
>> > End If
>> >End Sub
>> >----------------------------------------
>> >
>> >Function TrimFileHeader( _
>> > ByVal FileSpec As String, _
>> > ByVal LinesToTrim As Long, _
>> > Optional ByVal BackupExtension As String = "") As Long
>> >
>> >.......
>> >
>> >End function
>> >
>> >
>> >
>> >
>> >"Nick I" wrote:
>> >
>> >> John - Thanks for the reply but I found the problem: I didn't have the
>> >> Microsoft Scripting Runtime library enabled. After enabling that under
>> >> references, the code worked great! Thanks.
>> >>
>> >> "John Nurick" wrote:
>> >>
>> >> > The function was written to be called from VBA rather than from a macro,
>> >> > but it worked just fine using the RunCode macro action in my test
>> >> > database with this argument for the Function Name:
>> >> >
>> >> > TrimFileHeader("C:\TEMP\minlhe.txt",1)
>> >> >
>> >> > To find out what's happening, use the MsgBox macro action with something
>> >> > like this as the Message argument:
>> >> >
>> >> > ="TrimFileHeader: " &
>> >> > Error(TrimFileHeader("C:\folder\subfolder\filename.txt",4,"bak"))
>> >> >
>> >> > but using the actual location and name of your file. When you run the
>> >> > macro it will display just "TrimFileHeader:" if the function ran
>> >> > successfully, or else an error message (e.g. "TrimFileHeader: File Not
>> >> > Found"). The "bak" argument keeps a copy of the original file.
>> >> >
>> >> >
>> >> > On Thu, 3 Nov 2005 10:39:34 -0800, Nick I
>> >> > <[email protected]> wrote:
>> >> >
>> >> > >I'm new to Access. How do I run this code? I have four lines I want to cut
>> >> > >off a text file that I have.
>> >> > >
>> >> > >Do I create a macro, with an action run code, and put in
>> >> > >TrimFileHeader("filename of file", 4)? I tried that and nothing happened.
>> >> > >
>> >> > >Thanks in advance,
>> >> > >
>> >> > >Nick
>> >> > >
>> >> > >"John Nurick" wrote:
>> >> > >
>> >> > >> On Thu, 18 Aug 2005 16:12:33 -0400, "Ken Snell [MVP]"
>> >> > >> <[email protected]> wrote:
>> >> > >>
>> >> > >> >(1) Open the text file in VBA code, read the first 9 rows and ignore them,
>> >> > >> >then open a new text file and write each row (beginning with the 10th row)
>> >> > >> >from the first file into the second file. Close both files, and then import
>> >> > >> >the second file.
>> >> > >>
>> >> > >> Here's a VBA function to trim the first lines from a text file:
>> >> > >>
>> >> > >> Function TrimFileHeader( _
>> >> > >> ByVal FileSpec As String, _
>> >> > >> ByVal LinesToTrim As Long, _
>> >> > >> Optional ByVal BackupExtension As String = "") As Long
>> >> > >>
>> >> > >> 'Removes the specified number of lines from the beginning
>> >> > >> 'of a textfile.
>> >> > >> 'Optionally leaves the original file with its extension
>> >> > >> 'changed to BackupExtension.
>> >> > >> 'Returns 0 on success, otherwise the number of the error.
>> >> > >>
>> >> > >> Dim fso As Object 'Scripting.FileSystemObject
>> >> > >> Dim fIn As Object 'Scripting.TextStream
>> >> > >> Dim fOut As Object 'Scripting.TextStream
>> >> > >> Dim fFile As Object 'Scripting.File
>> >> > >> Dim strFolder As String
>> >> > >> Dim strNewFile As String
>> >> > >> Dim strBakFile As String
>> >> > >> Dim j As Long
>> >> > >>
>> >> > >> On Error GoTo Err_TrimFileHeader
>> >> > >>
>> >> > >> Set fso = CreateObject("Scripting.FileSystemObject")
>> >> > >>
>> >> > >> With fso
>> >> > >> 'Handle relative path in Filespec
>> >> > >> FileSpec = .GetAbsolutePathName(FileSpec)
>> >> > >> strFolder = .GetParentFolderName(FileSpec)
>> >> > >> strNewFile = .BuildPath(strFolder, fso.GetTempName)
>> >> > >> 'Open files
>> >> > >> Set fIn = .OpenTextFile(FileSpec, ForReading)
>> >> > >> Set fOut = .CreateTextFile(strNewFile, True)
>> >> > >>
>> >> > >> 'Dump header
>> >> > >> For j = 1 To LinesToTrim
>> >> > >> fIn.ReadLine
>> >> > >> Next
>> >> > >>
>> >> > >> 'Read and write remainder of file
>> >> > >> Do While Not fIn.AtEndOfStream
>> >> > >> fOut.WriteLine fIn.ReadLine
>> >> > >> Loop
>> >> > >>
>> >> > >> fOut.Close
>> >> > >> fIn.Close
>> >> > >>
>> >> > >> 'Rename or delete old file
>> >> > >> If Len(BackupExtension) > 0 Then
>> >> > >> strBakFile = .GetBaseName(FileSpec) _
>> >> > >> & IIf(Left(BackupExtension, 1) <> ".", ".", "") _
>> >> > >> & BackupExtension
>> >> > >> If .FileExists(.BuildPath(strFolder, strBakFile)) Then
>> >> > >> .DeleteFile .BuildPath(strFolder, strBakFile), True
>> >> > >> End If
>> >> > >> Set fFile = .GetFile(FileSpec)
>> >> > >> fFile.Name = strBakFile
>> >> > >> Set fFile = Nothing
>> >> > >> Else
>> >> > >> .DeleteFile FileSpec, True
>> >> > >> End If
>> >> > >>
>> >> > >> 'Rename new file
>> >> > >> Set fFile = .GetFile(strNewFile)
>> >> > >> fFile.Name = .GetFileName(FileSpec)
>> >> > >> Set fFile = Nothing
>> >> > >> Set fso = Nothing
>> >> > >>
>> >> > >> End With
>> >> > >> 'normal exit
>> >> > >> TrimFileHeader = 0
>> >> > >> Exit Function
>> >> > >> Err_TrimFileHeader:
>> >> > >> TrimFileHeader = Err.Number
>> >> > >> End Function
>> >> > >>
>> >> > >> --
>> >> > >> John Nurick [Microsoft Access MVP]
>> >> > >>
>> >> > >> Please respond in the newgroup and not by email.
>> >> > >>
>> >> >
>> >> > --
>> >> > John Nurick [Microsoft Access MVP]
>> >> >
>> >> > Please respond in the newgroup and not by email.
>> >> >
>> >> >
>>
>> --
>> John Nurick [Microsoft Access MVP]
>>
>> Please respond in the newgroup and not by email.
>>

--
John Nurick [Microsoft Access MVP]

Please respond in the newgroup and not by email.
Click to expand...
 
Back
Top