Start Free Trial

asked on

EDI TO CSV

Hello,
in 2010 I've asked for a macro help to convert an edi (.out file) that I receive daily from a client and I needed to convert to csv to be able to import into my database.

the macro that I used is/was working perfectly until this week when my client changed the file format.

My client added some lines to the file.

Please see attached macro I use., and sample csv file

I need your help changing the macro to recognize the changes.

changes are:
if you notice on line 10, line 25, Column "A" is empty.

I need to have 2 files created .
1- I need the macro to recognize and skip the lines that has colmn "A" empty. and save the file (FILE01) as .csv
2- I need the macro to recognize the lines with column "A" empty and ignore everything else, and save the file (FILE02) as .csv

is there any way the new file created can be saved automatically on the desktop?

Any help is appreciated.
macro.txt
sample.csv

Invoke this routine at the end of your current code.

Option Explicit

Public Sub GoodBadSplit()
    Dim wkb As Workbook
    Dim rngSrc As Range
    Dim rngCell As Range
    Dim rngTgt As Range
    Set rngSrc = ActiveSheet.Range("B1").CurrentRegion.Columns(1)
    Set wkb = Application.Workbooks.Add
    Set rngTgt = wkb.Sheets(1).Range("A1")
    For Each rngCell In rngSrc.Cells
        If Len(rngCell.Value) = 0 Then
            rngCell.EntireRow.Copy rngTgt
            Set rngTgt = rngTgt.Offset(1)
        End If
    Next
    Application.DisplayAlerts = False
    wkb.SaveAs rngSrc.Worksheet.Parent.Path & "\FILE02", XlFileFormat.xlCSV, , , , , , xlLocalSessionChanges
    wkb.Close False
    For Each rngCell In rngSrc.Cells
        If Len(rngCell.Value) = 0 Then
            rngCell.EntireRow.Delete
        End If
    Next
    Set wkb = rngSrc.Worksheet.Parent
    wkb.SaveAs rngSrc.Worksheet.Parent.Path & "\FILE01", XlFileFormat.xlCSV, , , , , , xlLocalSessionChanges
    wkb.Close False
End Sub

Open in new window

ASKER

Hello,
I get error message,
Run time error 424 -- Debug

Set wkb = rngSrc.Worksheet.Parent

Thanks,

What is the .Address property of rngSrc?
Is your (sample) workbook saved when you invoke this routine? If not, that might account for the error.

This is a simpler form of those two statements, since the path is already a property of the workbook object. However, this does use a different way to get to the workbook object that contains rngSrc and might be worth a try.

    Set wkb = rngSrc.Parent.Parent
    wkb.SaveAs wkb.Path & "\FILE01", XlFileFormat.xlCSV, , , , , , xlLocalSessionChanges

Open in new window

ASKER

Appreciate your help,
please see sample file attached.
I changed the extension to .txt from .out (I couldn't attach .out file)
sample.txt

please post the sample.out (as .txt) file that relates to the sample.csv file you posted earlier, or post the csv file related to the sample.out file you just posted.

ASKER

sorry, I dont have the original sample .out file, (I edited the data and saved)
attached is sample 2 (same exact format)
I also attached the csv file after I run my original Code without your code.

Again, I have to change the .out to .txt.
sample2.csv
sample2.txt

As a way of better understanding the import process, I did a manual import of the data (see attached). I noticed two things:
1. The " AA" data has been removed from column I
2. The "TT" and "AA" prefix data needs to be removed from the first of the right sided large number columns.
sample2-Imported.csv

This is the import command that I recorded:

    Workbooks.OpenText Filename:="C:\Users\Aikimark\Downloads\sample2.out", Origin:=437, _
        StartRow:=1, DataType:=xlFixedWidth, FieldInfo:=Array(Array(0, 1), _
        Array(8, 1), Array(14, 1), Array(29, 1), Array(39, 1), Array(55, 1), Array(63, 1), Array( _
        163, 1), Array(213, 1), Array(263, 1), Array(307, 1), Array(353, 1), Array(393, 1), Array( _
        403, 1), Array(418, 1), Array(422, 1), Array(424, 1), Array(439, 1), Array(451, 1), Array( _
        466, 1)), TrailingMinusNumbers:=True

Open in new window

ASKER

please see attached,
the 2 files should look like attached.
FILE01.csv
FILE02.csv

Should [P7] contain: TT1211111100?

This question reflects my earlier comment about the TT prefix and applies to several rows, not just row 7.

ASKER

yes, the TT are for certain order codes.
TT1211111100 is good.

* Where do the 102101000000 values come from?
* In column I, I see that the trailing " AA" characters have been removed. The macro seems to trim the last three characters from the column. Is that correct?

ASKER

Column Q & R
102101010210 0111211001 (column before last)
102101000000 (DATE+TIME)
0111211001

I think the trimming of AA is ok,,

Try this. I import and split the file. You won't need the macro that you posted.

Option Explicit


Public Sub ImportAndSplit()
    Dim wkb As Workbook
    Dim rngSrc As Range
    Dim rngCell As Range
    Dim rngTgt As Range
    Dim rngUsed As Range
    Dim strPath As String
    Application.ScreenUpdating = False
    'Open the file as fixed length data
    Workbooks.OpenText Filename:="C:\Users\aikimark\Downloads\sample2.out", Origin:=437, _
        StartRow:=1, DataType:=xlFixedWidth, FieldInfo:=Array(Array(0, 1), _
        Array(8, 1), Array(14, 1), Array(29, 1), Array(39, 1), Array(55, 1), Array(63, 1), _
        Array(163, 1), Array(213, 1), Array(263, 1), Array(307, 1), Array(353, 1), Array(393, 1), _
        Array(403, 1), Array(418, 1), Array(422, 1), Array(439, 1), Array(451, 1), _
        Array(466, 1)), TrailingMinusNumbers:=True
    strPath = ActiveWorkbook.Path
    Set rngUsed = ActiveSheet.Range([A1], ActiveSheet.Cells.SpecialCells(xlCellTypeLastCell))
    'Trim column I
    For Each rngCell In rngUsed.Columns(9).Cells
        rngCell.Value = Left(rngCell.Value, Len(rngCell.Value) - 3)
    Next
    'Zero out the time component of the date/time value in column Q
    For Each rngCell In rngUsed.Columns(17).Cells
        rngCell.Value = Left(rngCell.Value, 6) & "000000"
    Next
    'Format P:R as numeric (no decimals)
    rngUsed.Range("P:R").NumberFormat = "#0"
    
    Set rngSrc = rngUsed.Columns(1)
    Set wkb = Application.Workbooks.Add
    Set rngTgt = wkb.Sheets(1).Range("A1")
    For Each rngCell In rngSrc.Cells
        If Len(rngCell.Value) = 0 Then
            rngCell.EntireRow.Copy rngTgt
            Set rngTgt = rngTgt.Offset(1)
        End If
    Next
    Application.DisplayAlerts = False
    wkb.SaveAs strPath & "\FILE02", XlFileFormat.xlCSV, , , , , , xlLocalSessionChanges
    wkb.Close False
    For Each rngCell In rngSrc.Cells
        If Len(rngCell.Value) = 0 Then
            rngCell.EntireRow.Delete
        End If
    Next
    Set wkb = ActiveWorkbook
    wkb.SaveAs strPath & "\FILE01", XlFileFormat.xlCSV, , , , , , xlLocalSessionChanges
    wkb.Close False
    Application.ScreenUpdating = True
End Sub

Open in new window

ASKER

I get error
debug

Workbooks.OpenText Filename:="C:\Users\aikimark\Downloads\sample2.out", Origin:=437, _
StartRow:=1, DataType:=xlFixedWidth, FieldInfo:=Array(Array(0, 1), _
Array(8, 1), Array(14, 1), Array(29, 1), Array(39, 1), Array(55, 1), Array(63, 1), _
Array(163, 1), Array(213, 1), Array(263, 1), Array(307, 1), Array(353, 1), Array(393, 1), _
Array(403, 1), Array(418, 1), Array(422, 1), Array(439, 1), Array(451, 1), _
Array(466, 1)), TrailingMinusNumbers:=True

ASKER

sorry, forget my last comment,
I didnt change the file default

ASKER

Hello,
this is working great, thanks.

can i ask you to just fix Column "C" in File01, (it has leading zeroes)
15 characters , example 000000000066108

Also,
File02, are u able to move over Columns A,B,C
A should move over to B
B should move over to C
C should move over to D

Column "A" should be date only (getdate)

I appreciate if you can help me with this.
thanks,

1. I don't see leading zeroes in the FILE01 produced from the sample.out file you posted.

2. Col A data is not a recognizable date string

3. What is the (getdate) to which you refer?

ASKER

Hello,
1. I don't see leading zeroes in the FILE01 produced from the sample.out file you posted.
not sure why, but If I look at the field, it has leading zeroes,
Same thing for Column "R", IT has leading zero (10 characters in total)

I appreciate if you can help.

3. What is the (getdate) to which you refer?
I needed to get today's date into Column "A", IN FILE 2 (If possible),

thanks,

Please post the .out file you are using for your tests.

ASKER

Maybe I just don't understand what you mean by "fix" in relation to column C.
* I don't see anything like 000000000066108 data in the column
* All of the imported data in the column is treated as a number - the leading zeroes have been removed.

ASKER

Column "c",
I need to keep the leading zeroes when the files created.

Same for Column "R"

I've set columns C,P:R to import as type text instead of type General. Opening the FILE01 with Notepad shows the leading zeroes.

FILE02 now has the current date in column A.

Option Explicit


Public Sub ImportAndSplit()
    Dim wkb As Workbook
    Dim rngSrc As Range
    Dim rngCell As Range
    Dim rngTgt As Range
    Dim rngUsed As Range
    Dim strPath As String
    Application.ScreenUpdating = False
    'Open the file as fixed length data
    Workbooks.OpenText Filename:="C:\Users\aikimark\Downloads\sample2.out", Origin:=437, _
        StartRow:=1, DataType:=xlFixedWidth, FieldInfo:=Array(Array(0, 1), _
        Array(8, 1), Array(14, 2), Array(29, 1), Array(39, 1), Array(55, 1), Array(63, 1), _
        Array(163, 1), Array(213, 1), Array(263, 1), Array(307, 1), Array(353, 1), Array(393, 1), _
        Array(403, 1), Array(418, 1), Array(422, 2), Array(439, 2), Array(451, 2), _
        Array(466, 1)), TrailingMinusNumbers:=True
    strPath = ActiveWorkbook.Path
    Set rngUsed = ActiveSheet.Range([A1], ActiveSheet.Cells.SpecialCells(xlCellTypeLastCell))
    'Trim column I
    For Each rngCell In rngUsed.Columns(9).Cells
        rngCell.Value = Left(rngCell.Value, Len(rngCell.Value) - 3)
    Next
    'Zero out the time component of the date/time value in column Q
    For Each rngCell In rngUsed.Columns(17).Cells
        rngCell.Value = Left(rngCell.Value, 6) & "000000"
    Next
    
    Set rngSrc = rngUsed.Columns(1)
    Set wkb = Application.Workbooks.Add
    Set rngTgt = wkb.Sheets(1).Range("A1")
    For Each rngCell In rngSrc.Cells
        If Len(rngCell.Value) = 0 Then
            rngCell.EntireRow.Copy rngTgt
            Set rngTgt = rngTgt.Offset(1)
        End If
    Next
    Set rngTgt = rngTgt.Offset(-1)
    rngTgt.Worksheet.Range([A1], rngTgt).Value = Date
    Application.DisplayAlerts = False
    wkb.SaveAs strPath & "\FILE02", XlFileFormat.xlCSV, , , , , , xlLocalSessionChanges
    wkb.Close False
    For Each rngCell In rngSrc.Cells
        If Len(rngCell.Value) = 0 Then
            rngCell.EntireRow.Delete
        End If
    Next
    Set wkb = ActiveWorkbook
    wkb.SaveAs strPath & "\FILE01", XlFileFormat.xlCSV, , , , , , xlLocalSessionChanges
    wkb.Close False
    Application.ScreenUpdating = True
End Sub

Open in new window

ASKER

I get error 1004

Set rngTgt = rngTgt.Offset(-1)

were there any 'bad' rows in the data?

if there are no 'bad' rows, should there be a FILE02? If so, what should it contain?

ASKER

no bad rows,

I was testing on a live file, the file doesn't have any lines , that would create file02,
I added one line, then I get NO errors and file02 was created.
not sure if there is a way to skipp file02 if nothing found????

I guess there is no way I can see the leading zeroes on the .csv file ? (paste special)
(I use this file to import into my sql DATABASE).

Thanks again,

ASKER CERTIFIED SOLUTION

membership

This solution is only available to members.

To access this solution, you must be a member of Experts Exchange.

Start Free Trial

ASKER

Beautiful,
works like a charm,

I appreciate all your help and time.