简体   繁体   中英

VBA - Flat Text Import Changes

We have a mission critical spreadsheet that imports a lot of flat text from a desgin program and then brings it in to this spreadsheet.

We recently updated the design software, which we do once a year and have done so in my 12 years here. This year, they made a change to a file where it placed the header of a column of text in a different place. Now, our program will not import it correctly. It is the PART column...

Old text file:

在此处输入图像描述

New Text File...

在此处输入图像描述

So as you can see, they moved PART to the lower left.

Not being an expert in VBA, I am struggling to find exactly where I need to modify the code to bring it in properly..

This is the section of VBA code where I do think the selections are made but nothing specifies PART in the code...perhaps it is part of the Array? The file is called CZE_DET.OUT.

    Sub IMPORT_CZEOUT()
    Dim aryJobs() As String
    Dim strComb As String
    Dim strDir As String
    Dim i As Integer
    Dim j As Integer
    Dim k As Integer

    Sheets("CEE ORDER").Visible = True
    Sheets("CZE_DET").Visible = True
    Application.DisplayAlerts = False
    Application.ScreenUpdating = False

    Sheets("CEE ORDER").Select
    For i = 1 To colAllBuildings.Count
        strDir = Dir$(colAllBuildings.Item(i) & "\CZE_DET.OUT")
        If strDir <> "" Then
            Workbooks.OpenText Filename:=colAllBuildings.Item(i) & "\CZE_DET.OUT", Origin:=xlWindows, _
                               StartRow:=7, DataType:=xlFixedWidth, _
                               FieldInfo:=Array(Array(0, 9), Array(5, 1), Array(9, 9), Array(10, 1), _
                               Array(13, 9), Array(14, 1), Array(15, 9), Array(16, 1), Array(18, 1), _
                               Array(28, 9), Array(35, 9), Array(47, 9), Array(54, 1), Array(57, 1), _
                               Array(62, 1), Array(67, 1), Array(72, 1))
            Range("A1:L" & CStr(Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row)).Select
            Selection.Copy
            Windows(strShipperName).Activate ' This line does not work, for NO reason!
'            Windows(1).ActivatePrevious
            Sheets("CZE_DET").Select
            Range("A1").Select
            If Range("A1").Value <> "" Then
                ActiveSheet.Range("A65536").End(xlUp).Select
                ActiveCell.Offset(1, 0).Select
            End If
            Selection.PasteSpecial Paste:=xlValues
            Selection.Sort Key1:=Range("A12"), Order1:=xlAscending, Orientation:=xlTopToBottom
            Windows("CZE_DET.OUT").Activate
            ActiveWindow.Close
        End If
    Next

I would post the spreadsheet but it attaches the VBA though an XLA file through a.network share. And the XLA file is protected and I can't seem to rename it and remove password to send a link.

I posted the entire subroutine here as I only posted where I thought t the problem would be: https://pinnaclestructures365-my.sharepoint.com/:f:/g/personal/bwolters_pinnaclestructures_com/EpGrxtGx4_BCgL4nl3QDZxcBalaRSL52pI0S8UNX0n6kOg?e=0oyh2k

Any suggestions?

Here is a re-worked example of how to make your references more explicit.

Sub IMPORT_CZEOUT()
    Dim aryJobs() As String
    Dim strComb As String
    Dim strDir As String
    Dim i As Integer, cDest As Range
    Dim j As Integer, fName As String, rngData As Range, lRow As Long
    Dim k As Integer, wb As Workbook, wbSrc As Workbook, wsSrc As Worksheet

    Set wb = Workbooks(strShipperName) 'The wb where data is to be collected
                                       'Include the file extension!
    wb.Sheets("CEE ORDER").Visible = True
    wb.Sheets("CZE_DET").Visible = True
    
    Application.DisplayAlerts = False
    Application.ScreenUpdating = False

    For i = 1 To colAllBuildings.Count
        fName = colAllBuildings.Item(i) & "\CZE_DET.OUT"
        If Len(Dir(fName)) > 0 Then
            Workbooks.OpenText Filename:=fName, Origin:=xlWindows, _
                               StartRow:=7, DataType:=xlFixedWidth, _
                               FieldInfo:=Array(Array(0, 9), Array(5, 1), Array(9, 9), Array(10, 1), _
                               Array(13, 9), Array(14, 1), Array(15, 9), Array(16, 1), Array(18, 1), _
                               Array(28, 9), Array(35, 9), Array(47, 9), Array(54, 1), Array(57, 1), _
                               Array(62, 1), Array(67, 1), Array(72, 1))
            Set wbSrc = ActiveWorkbook      'source data workbook
            Set wsSrc = wbSrc.Worksheets(1) 'source data sheet
            lRow = wsSrc.Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
            Set rngData = wsSrc.Range("A1:L" & lRow) 'all source data
            With wb.Worksheets("CZE_DET") 'EDIT
                Set cDest = .Cells(.Rows.Count, "A").End(xlUp)
            End With
            If Len(cDest.Value) > 0 Then Set cDest = cDest.Offset(1)
            cDest.Resize(rngData.Rows.Count, rngData.Columns.Count).Value = rngData.Value
            'not sure about this line....
            Selection.Sort Key1:=Range("A12"), Order1:=xlAscending, Orientation:=xlTopToBottom
            wbSrc.Close savechanges:=False 'close the source file
        End If
    Next
    
    Application.DisplayAlerts = True
    Application.ScreenUpdating = True
End Sub

EDIT - as pointed out in a comment, the length of one of the fileds has increased by 1 character, so the FieldInfo argument needs to be updated:

Workbooks.OpenText Filename:=fName, Origin:=xlWindows, _
                           StartRow:=7, DataType:=xlFixedWidth, _
                           FieldInfo:=Array(Array(0, 9), Array(5, 1), Array(9, 9), Array(10, 1), _
                           Array(13, 9), Array(14, 1), Array(15, 9), Array(16, 1), Array(18, 1), _
                           Array(28, 9), Array(35, 9), Array(47, 9), Array(55, 1), Array(58, 1), _
                           Array(63, 1), Array(68, 1), Array(73, 1))

The open statement could be simplified as the skipped fields (type=9) are the blanks and values are trimmed on import.

Workbooks.OpenText Filename:=s, Origin:=xlWindows, _
          StartRow:=7, DataType:=xlFixedWidth, _
          FieldInfo:=Array(Array(0, 9), Array(4, 1), Array(18, 1), Array(27, 1), _
                           Array(35, 1), Array(54, 1), Array(58, 1),  _ 
                           Array(63, 1), Array(68, 1), Array(73, 1))

Tested with this text file

line 1
line 2
line 3
line 4
line 5
line 6
ish description   part     punch   comment            qnt feet inch 16th mark
--- ------------- -------- ------- ------------------ --- ---- ---- ---- ------
xxx  8.0x3.5 c 12 8x35c12  psu-psu see drawing ec-1    28  16    8    3  ec-1
xxx  8.0x3.5 c 12 8x35c12  psu-psu see drawing ec-1    28  16    8    3  ec-1
xxx  8.0x3.5 c 12 8x35c12  psu-psu see drawing ec-1    28  16    8    3  ec-1
a-z a-----------z a----- z a-----z a----------------z a-z a--z a--z a--z a----z

The technical post webpages of this site follow the CC BY-SA 4.0 protocol. If you need to reprint, please indicate the site URL or the original address.Any question please contact:yoyou2525@163.com.

 
粤ICP备18138465号  © 2020-2024 STACKOOM.COM