.txt importeren naar Excel en reformatten

[Ravnoss]

Beste iedereen,

Ik zit met een probleem waar ik nu al enkele dagen mee aan het stoeien ben en maar niet uitkom. Ik krijg elke week een .txt bestand toegestuurd, die ik vervolgens moet importeren naar Excel en in een ander format gieten. Dit kost me elke keer enkele uren om dat met de hand te doen, een ik vroeg me dan ook af of dit op een of andere manier geautomatiseerd kan worden.

Bijgevoegd vind je een Excel bestand, waar je ziet hoe het moet worden en de .txt file waarin de informatie wordt aangeleverd. Ik ben benieuwd wat jullie als mogelijke oplossing zien?

 

[john ross]

Hallo

kijk hier eens



succes

 

[Ravnoss]

Bedankt voor de snelle reactie

Dat importeren heb ik vele malen geprobeerd. Echter helpt dat me niet veel verder, immers moet ik dan nog alles handmatig van het oude format, naar het nieuwe format veranderen.

 

[Ravnoss]

Uiteindelijk is het gelukt met de volgende code. Misschien heeft iemand er nog wat aan.

Sub Format_File()

Dim strFileName
Dim strBatch As String, strPSNum As String, strPONum As String, strShipTo As String
Dim strOrderNum As String, strCustNum As String
Dim lngLastRow As Long, rngProcess As Range, lngWriteRow As Long, lngMyRow As Long

strFileName = Application.GetOpenFilename("Text Files (*.txt), *.txt")

If strFileName = False Then

    MsgBox "No file selected!", vbInformation
    Exit Sub
    
End If

Application.ScreenUpdating = False

Workbooks.OpenText Filename:=strFileName, Origin:=xlMSDOS, StartRow:=1, _
    DataType:=xlFixedWidth, FieldInfo:=Array(Array(0, 2), Array(31, 2), Array(46, 2) _
    , Array(80, 1), Array(91, 1), Array(100, 1), Array(117, 1)), TrailingMinusNumbers:= _
    True

Rows("1:32").Delete

Columns("A:F").Insert

lngLastRow = Cells(Rows.Count, 9).End(xlUp).Row

For Each rngProcess In Range("I1:I" & lngLastRow)

If rngProcess = "Bup Open Batch report" Then

    With rngProcess.Offset(7, -2)
        strBatch = Right(.Value, Len(.Value) - 8)
    End With
    
    lngWriteRow = rngProcess.Row + 13
    Cells(lngWriteRow, 1) = strBatch
    
End If

If rngProcess = "Description" Then
    
    With rngProcess.Offset(-1, -2)
        strPSNum = Right(.Value, Len(.Value) - 17)
    End With

    With rngProcess.Offset(0, -2)
        strPONum = Right(.Value, Len(.Value) - 10)
    End With

    With rngProcess.Offset(1, -2)
        strShipTo = Right(.Value, Len(.Value) - 8)
    End With
    
    With rngProcess.Offset(2, -2)
        strOrderNum = Right(.Value, Len(.Value) - 13)
    End With

    With rngProcess.Offset(3, -2)
        strCustNum = Right(.Value, Len(.Value) - 16)
    End With

    lngWriteRow = rngProcess.Row + 2
    
    Cells(lngWriteRow, 2) = strPSNum
    Cells(lngWriteRow, 3) = strPONum
    Cells(lngWriteRow, 4) = strShipTo
    Cells(lngWriteRow, 5) = strOrderNum
    Cells(lngWriteRow, 6) = strCustNum
    
End If

Next rngProcess

For lngMyRow = lngLastRow To 1 Step -1

    If Cells(lngMyRow, 9) = "" Or Cells(lngMyRow, 8) = "" Or Cells(lngMyRow, 9) = "Description" Or _
        Cells(lngMyRow, 9) = "---------------------------------" Then Rows(lngMyRow).Delete
    
Next lngMyRow

Columns("G").Delete

Rows("1").Insert

With Range("A1:L1")
    .Value = Array("Batch", "Pick Slip Number", "PO Number", "SHIP TO", "Order Number", "Customer Number", "SKU", "Description", "Requested", "Shipped", "Remaining", "Sales Value")
    .Font.Bold = True
End With

Columns("A:L").AutoFit

Application.ScreenUpdating = True

End Sub