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?
CodePudding user response：
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))
CodePudding user response：
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