Trouble Importing txt file ";" delim with fields containing "&quo

[joel009]

Her's my code:
'import KanBan spreadsheet
If (MsgBox("Are you sure you want to delete the tblnameTable?", vbYesNo, "Warning!!! This operation can not be reversed")) = vbYes Then
'first delete old table
DoCmd.DeleteObject acTable, "tbltableName"
'copy new table from template, resets ID field
DoCmd.CopyObject , "tblTableName", acTable, "TableNameTemplate"
'import ; deliminted table using import spec
DoCmd.TransferText acImportDelim, "tblTableNameImportSpecification", "tblTableNameImport", "C:\ProplannerProcessing\FolderDownload\ImportFile10042010v1.txt", 0

What happens is the Import Specification (thank you Bill G for changing the name , used to be Schema) specifies ";" delim and in the file I am importing it has fields with quotes around individual letters. Example

;02452 ;BLUE ;06032031 ;M46 L;T1934L;1910 ;000003900;000;NUT/SPRG."U"1TH;K02A03 ;230C ;V;500;PC;A;02452 N;Y; ;

NUT/SPRG."U"1TH is the problem.

The field is a description field and the data has to remain as is.

The import spec(s) brings in everything except rows with this type of data. I get the table for import errors in Access and it is saying "Unparsable Record" with the row number. I am assuming that the problem is the quotes.

I have tried to use an Import Spec with a Text Qualifier as {None} and/or " with the same results "Unparsable Record" and losing those records.

Any ideas as to how I would import the ; delim file and include records with fields containing quotes?

Can I open the txt file and loop throug and .addnew to the table? There are also CR/LF characters in the file that I remove later using a query.

ideas, gentle nudges, epiphanies?

Thanks in advance,

Jeol


Joel

 

[MajP]

A workaround might be to replace in the original " with some weird character combo like ~~~. Then do an update query to replace all ~~~ with ".

 

[joel009]

Thanks MajP - now I've got to figure out how to open the file for edit and replace the """ (ascii 42) with "~" (Ascii 176).

I have both .csv and .txt files that have the values.

I thought there was an easier way. Ho -hum, back to the keyboard.
Joel

Joel

 

[joel009]

Any suggestions on opening these types of files and editing. I've tried Excel but it isn't co-operating. Should I use notepad. I've done so much trail and error today I need a trial and success.

Thanks in advance,
Joel

Joel

 

[MajP]

This seemed to work. The code is not mine.

Sub ReplaceTextInFile(SourceFile As String, _
    sText As String, rText As String)
Dim TargetFile As String, tLine As String, tString As String
Dim p As Integer, i As Long, F1 As Integer, F2 As Integer
    TargetFile = "RESULT.TMP"
    If Dir(SourceFile) = "" Then Exit Sub
    If Dir(TargetFile) <> "" Then
        On Error Resume Next
        Kill TargetFile
        On Error GoTo 0
        If Dir(TargetFile) <> "" Then
            MsgBox TargetFile & _
                " already open, close and delete / rename the file and try again.", _
                vbCritical
            Exit Sub
        End If
    End If
    F1 = FreeFile
    Open SourceFile For Input As F1
    F2 = FreeFile
    Open TargetFile For Output As F2
    i = 1 ' line counter
      While Not EOF(F1)
         Line Input #F1, tLine
        If sText <> "" Then
            ReplaceTextInString tLine, sText, rText
        End If
        Print #F2, tLine
        i = i + 1
    Wend
    Close F1
    Close F2
    Kill SourceFile ' delete original file
    Name TargetFile As SourceFile ' rename temporary file
End Sub

Private Sub ReplaceTextInString(SourceString As String, _
    SearchString As String, ReplaceString As String)
Dim p As Integer, NewString As String
    Do
        p = InStr(p + 1, UCase(SourceString), UCase(SearchString))
        If p > 0 Then ' replace SearchString with ReplaceString
            NewString = ""
            If p > 1 Then NewString = Mid(SourceString, 1, p - 1)
            NewString = NewString + ReplaceString
            NewString = NewString + Mid(SourceString, _
                p + Len(SearchString), Len(SourceString))
            p = p + Len(ReplaceString) - 1
            SourceString = NewString
        End If
        If p >= Len(NewString) Then p = 0
    Loop Until p = 0
End Sub

Sub TestReplaceTextInFile()
    ReplaceTextInFile "c:/CSV.txt", """", "~~"
End Sub

 

[joel009]

here is what I had Friday by EOB:

For selecting my file:
strFolderPath = "C:\ProplannerProcessing\PartsDumpDownload"

Set objFS = CreateObject("Scripting.FileSystemObject")
Set objFolder = objFS.GetFolder(strFolderPath)
Set objFiles = objFolder.files

'should only be one file in folder
Select Case objFiles.Count
Case 0
MsgBox "There is no file in folder 'C:\ProplannerProcessing\PartsDumpDownload'" & vbCrLf & vbCrLf _
& "Please place the PartDump file in this folder and try again.", vbOKOnly + vbExclamation, "File Import Error!!!"
Exit Sub
Case 1
'proceed, correct number of files found
'no action necessary
Case Is <> 1
MsgBox "There are multiple .csv files in folder 'C:\ProplannerProcessing\PartsDumpDownload'" & vbCrLf & vbCrLf _
& "Please place the current PartDump file only in this folder and try again.", vbOKOnly + vbExclamation, "File Import Error!!!"
Exit Sub
Case Else
Exit Sub
End Select



For Each objFiles In objFiles 'should only be one file in folder
If Right(objFiles.Name, 3) = "txt" Then
strFile = strFolderPath & "\" & objFiles.Name
'open txt file with Excel
EditFileContents strFile
DoCmd.TransferText acImportFixed, "PartDumpImportSpec", "tblPartDumpImport", strFile, -1
End If
Exit For
Next

Set objFS = Nothing
Set objFolder = Nothing
Set objFiles = Nothing
For Public sub EditFileContents :

Public Sub EditFileContents(strFileName As String)

'open txt file with Excel
'Make the text comparisons NOT case dependent
Dim intFile As Integer
Dim strCurrentLine As String
Dim lngLastRow As Long
Dim xlApp As Object
Dim xlBook As Object
Dim xlSheet As Object

Set xlApp = CreateObject("Excel.Application")
xlApp.DisplayAlerts = False
Set xlBook = xlApp.Workbooks.Open(strFileName)
Set xlSheet = xlBook.Sheets(1)
xlSheet.Activate 'should be only one sheet
lngLastRow = xlSheet.UsedRange.Rows.Count + 1
xlSheet.Range("A1:AG" & lngLastRow).Replace What:=Chr(42), Replacement:=Chr(53), ReplaceFormat:=False

' Dim objNotePad As Object ' or word.application
' Dim objFile As Object ' or word.documentset
' objNotePad = CreateObject("Excel.Application")
'
' objFile.Activate 'should be only one sheet
' 'loop through file and replace char(42)" with char(176)~
' 'clean up after import
' lngLastRow = objFile.UsedRange.Rows.Count + 1
' With objFile
'' Do Until objFile.EOF
' xlSheet.Range("A1:AG" & lngLastRow).Replace What:=Chr(42), Replacement:=Chr(176), LookAt:=xlPart, _
' SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
' ReplaceFormat:=False

' .MoveNext
' Loop

xlBook.Close savechanges:=True
xlApp.DisplayAlerts = True
Set xlSheet = Nothing
Set xlBook = Nothing
xlApp.Quit

' 'The Left() & Mid() Functions below are based on this map
' 'Description Totals GroupSet CycleDate
' '123456789,123456789,123456789,123456789,123456789,123456789
'
' 'Next three lines For handling input file
' 'Change the text in bold to match the path & name of your text file
' Const cFileName As String = "strFileName"
'''' Dim intFile As Integer
'''' Dim strCurrentLine As String
'
' 'Next two lines For output
' Dim strDescription As String, strTotals As String
' Dim strGroupSet As String, strCycleDate As String
'
' 'Open the file
' intFile = FreeFile
' Open cFileName For Input As #intFile
'
' 'Process the input file one line at a time
' Do
' Line Input #intFile, strCurrentLine
' 'Test the line and decide what To Do, used both
' 'Like and InStr() For demonstration, either will work
' If strCurrentLine Like "Description*" Then
' 'Header line, Do Nothing
' ElseIf InStr(strCurrentLine, char(42)) Then
' 'replace char(42)" with char(176)~
' ElseIf strCurrentLine Like "CycleDate*" Then
' strCycleDate = Trim(Mid(strCurrentLine, 35))
' ElseIf strCurrentLine Like "Description*" Then
' strGroupSet = Trim(Mid(strCurrentLine, 27, 8))
' Else
' strDescription = Trim(Left(strCurrentLine, 16))
' strTotals = Trim(Mid(strCurrentLine, 17, 9))
' '*** Should be a complete record, Do something
' '*** with the data here
' Debug.Print strDescription, strTotals, strGroupSet, strCycleDate
' End If
' Loop Until EOF(intFile)
'
' 'Close the input file
' Close #intFile

End Sub

The Remd out fields in the Publis sub those are my dev trail - funny isn't it!!!
I think I am close and thank you all for your suggestions of which I will now copy to my example database because I really do hate reinventing the freaking wheel!!! (lost mine when I was WFR'd from my last job)

Joel Thank you all!




Joel

 

[joel009]

Heloo All,
I am still having problems with this file.

I've ended up opening the thing with Excel in Access VBA and editing what I thought was all the bad fields out that MS is considering delimiters ( it sees the ~ as a delim too). Close and save it back to the same txt file and then trying to reopen with Excel again and everything is staying in the first column. I am still getting a blank space for the rows I removed the funny little box with a "?", chr(12) and am wondering if that would fix the problem.

Here is what I have:
xlSheet.Range("A1:A" & lngLastRow).Replace What:=Chr(8), Replacement:="", LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
ReplaceFormat:=False
'horizontal tab
xlSheet.Range("A1:A" & lngLastRow).Replace What:=Chr(9), Replacement:="", LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
ReplaceFormat:=False
'line feed
xlSheet.Range("A1:A" & lngLastRow).Replace What:=Chr(10), Replacement:="", LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
ReplaceFormat:=False
'vertical tab
xlSheet.Range("A1:A" & lngLastRow).Replace What:=Chr(11), Replacement:="", LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
ReplaceFormat:=False
'form feed, page eject
xlSheet.Range("A1:A" & lngLastRow).Replace What:=Chr(12), Replacement:="", LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
ReplaceFormat:=False
'carriage return
xlSheet.Range("A1:A" & lngLastRow).Replace What:=Chr(13), Replacement:="", LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
ReplaceFormat:=False
'space
xlSheet.Range("A1:A" & lngLastRow).Replace What:=Chr(32), Replacement:="", LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
ReplaceFormat:=False
'double ;;
xlSheet.Range("A1:A" & lngLastRow).Replace What:=";;", Replacement:=Chr(59), LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
ReplaceFormat:=False
'close Excel and save it
xlBook.Close savechanges:=True

which saves it back as a .txt file. I was hoping if I got rid of all the junk and opened it again with Excel in VBA it would be a good little file and be in a state to import. If I can't figure this out I will have to set something up to parse through the string in column A (the whole record seperated by ; in column A) looking for ";" and taking all the characters in between and writing them to my Access table field by field, clumsey and slow.

Does anyone know how to delete a row in an open Excel workbook.worksheet using my methods above considering it will be ""?

Better yet, any idea on handeling this differently. The filoe is exported via a web page and the result set is static , unable to change on a 90 day contract. It comes as a (supposedly) ";" delim file with a .txt extension.

The first row is blank, the second row has the headers and it starts without a ; and ends with a single ; the 3rd row is blank but the 4th row where the data starts begins with a ; and end with "; ;" as do all the rest of the rows except the occasional chr(12). If I remove the chr(12) like shown above it leaves a blank line behind which I would like to remove. Any ideas???

WAGS and SWAGS welcome.

Joel

 

[MajP]

Any chance you could post a file with a representative amount of rows? It would make it a lot easier to see what works and what does not.

 

[joel009]

My solution was to open the file with Excel, edit the contents and then create a import specification to import it as a text file.

Set xlApp = CreateObject("Excel.Application")
xlApp.DisplayAlerts = False
Set xlBook = xlApp.Workbooks.Open(strFileName)
Set xlSheet = xlBook.Sheets(1)
xlSheet.Activate 'should be only one sheet and it should be first in the workbook
lngLastRow = xlSheet.UsedRange.Rows.Count + 1 'not always reliable, only use on stable input Excel input

Select Case strButtonClicked
Case "PartDump"
Set dbImport = CurrentDb ' or DBEngine.Workspaces(0).Databases(0) both work
Set rsDesiredTable = dbImport.OpenRecordset("SELECT * FROM tblPartDumpImport")
intTableFieldCount = 36 + 1 'table fields +1

Case "KanBan"
'first time Excel opens the file all records are in column A concaented into one cell
'remove unwanted characters
'backspace
xlSheet.Range("A1:A" & lngLastRow).Replace What:=Chr(8), Replacement:="", LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
ReplaceFormat:=False
'horizontal tab
xlSheet.Range("A1:A" & lngLastRow).Replace What:=Chr(9), Replacement:="", LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
ReplaceFormat:=False
'line feed
xlSheet.Range("A1:A" & lngLastRow).Replace What:=Chr(10), Replacement:="", LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
ReplaceFormat:=False
'vertical tab
xlSheet.Range("A1:A" & lngLastRow).Replace What:=Chr(11), Replacement:="", LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
ReplaceFormat:=False
'form feed, page eject
xlSheet.Range("A1:A" & lngLastRow).Replace What:=Chr(12), Replacement:="", LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
ReplaceFormat:=False
'carriage return
xlSheet.Range("A1:A" & lngLastRow).Replace What:=Chr(13), Replacement:="", LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
ReplaceFormat:=False
'space
xlSheet.Range("A1:A" & lngLastRow).Replace What:=Chr(32), Replacement:="", LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
ReplaceFormat:=False
'double ;;
xlSheet.Range("A1:A" & lngLastRow).Replace What:=";;", Replacement:=Chr(59), LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
ReplaceFormat:=False

lngLastRow = xlSheet.UsedRange.Rows.Count + 1 'not always reliable, only use on stable input Excel input

lngRowCount = 1

'remove blank rows,; at front of string if they exist
Do Until lngRowCount = lngLastRow - 1

xlSheet.Cells(lngRowCount, 1).Select

If IsNull(xlSheet.Cells(lngRowCount, 1)) = True Or xlSheet.Cells(lngRowCount, 1) = "" Then
xlSheet.Cells(lngRowCount, 1).EntireRow.Delete
lngRowCount = lngRowCount - 1
lngLastRow = xlSheet.UsedRange.Rows.Count + 1
'*****************************************
'not needed, removing this throws off the import specification
'first ; is the CC column from KanBan and it is not imported
'it is skipped by the import spec
''' ElseIf InStr(1, xlSheet.Cells(lngRowCount, 1).Text, Chr(59), vbTextCompare) = 1 Then
''' xlSheet.Cells(lngRowCount, 1).Value = Right(xlSheet.Cells(lngRowCount, 1).Value, Len(xlSheet.Cells(lngRowCount, 1).Value) - 1)
'**********************************************************************
End If
lngRowCount = lngRowCount + 1
Loop 'adds 1 to the variable

xlBook.Close savechanges:=True


Too way too long for me. Example of the file.

CC;PLANT;ROUTE;PART;BAY;STATION;DELV SEQ;PACK SIZE; % USE; PART DESC; STORAGE;WORK STATION;REQ TYPE;TIP; TIP UOM;STATUS;MATSRC; QUAL; SPD/BULK;

;02452 ;BIW-01;06507091AA;BC-43 ;BE40L ;0001 ;000001000;000;SC&WA/HEX.HD - ;EXEL ;06F8 ;P;001;CT;A;02452 N;N; ;
;02452 ;BIW-01;06507091AA;BC-43 ;BE40R ;0002 ;000001000;000;SC&WA/HEX.HD - ;EXEL ;0609 ;P;001;CT;A;02452 N;N; ;
;02452 ;BIW-01;06100051 ;BC-43 ;B0394L;0030 ;000045000;000;NUT ;E04B01 ;0704 ;P;001;CT;A;02452 ;N; ;
;02452 ;BIW-01;06100051 ;BA-43 ;B0394R;0040 ;000045000;000;NUT ;E04B01 ;0715 ;P;001;CT;A;02452 ;N; ;
;02452 ;BIW-01;06503102 ;BC-43 ;B0392L;0050 ;000091800;000;NUT ;E20B01 ;0704 ;P;001;CT;A;02452 ;N; ;
;02452 ;BIW-01;06503102 ;BA-43 ;B0392R;0060 ;000091800;000;NUT ;E20B01 ;0715 ;P;001;CT;A;02452 ;N; ;
;02452 ;BIW-01;06508265AA;BA-43 ;B0389L;0070 ;000058500;000;SC&WA.CA/HEX.HD;F18B02 ;0704 ;P;001;CT;A;02452 ;N; ;
;02452 ;BIW-01;06508265AA;BA-43 ;B0389R;0080 ;000058500;000;SC&WA.CA/HEX.HD;F18B02 ;0715 ;P;001;CT;A;02452 ;N; ;
Every 40 lines or so there would be another CR/LF or page beak with a blank line(no data).

Thanks for all the help!!!!

Joel

 

[MajP]

So does your solution work as desired? Or are there still problems/desired fixes? I thought from your original post that it would not even import into excel.

 

[joel009]

Hi MajP - Yes is working as desired. Just thought I'd post the solution. Use of Excel and VBA from Access has always been tricky for me. Is this the correct forum for this discussion? Searching in thios forum produced few results that benifited me.

Any suggestions?

Joel

 

[MajP]

This forum is fine, most of the Access forums are monitored by the same people. There is one form Forms, Modules, Queries, Reports, and Other (general) topics.
There is also a "VBA Visual Basic For Applications (Microsoft)" forum which is Excel centric, which is better for specific Excel coding.