0

I'm using a simple VBA script to copy one cell value (E1) into another (Q1) in a list of files:

Original file shown in text editor: Original file shown in text editor Original file shown in Excel: Original file shown in Excel

Sub header_austauschen()
    ChDir (ActiveWorkbook.Sheets("Tabelle1").Range("D8"))
    Nextfile = Dir("*.XLS")
    While Nextfile <> ""
        Workbooks.Open (Nextfile)
        Workbooks(Nextfile).Sheets(1).Range("Q1") = Workbooks(Nextfile).Sheets(1).Range("E1")
        Workbooks(Nextfile).Save
        Workbooks(Nextfile).Close
        Nextfile = Dir()
    Wend
End Sub

The problem is that after the operation, the tab stop right before the "CR" is lost in all lines of the file, hence the resulting text file can not be processed anymore by our software tool:

Altered file shown in text editor

How can I preserve the tab stopp? Or add it back in afterwards? I've tried adding & vbTab to the script where the copying is happening but it didn't work (and it would only affect the first line anyway).

It doesn't have to happen in VBA but could be done using some sort of script. I found a way by performing a simple search & replace in Notepad++, however an automated script solution would be much preferred. Search & replace in Notepad++

Thanks!


UPDATE

Here's my new code (a mix of my original code and the snippet from taller_ExcelHome's reply) which is processing all files in a specified folder:

Sub header_austauschen_neu()
    Dim j As Integer
    Dim file As String, newFile As String
    Dim lines() As String, words() As String
    Dim i As Integer
    
    DataDir = ActiveWorkbook.Sheets("Tabelle1").Range("D8") 'fetching file location from user input in table
    MsgBox ("Alle *.XLS Dateien im Ordner" & vbCrLf & vbCrLf & DataDir & vbCrLf & vbCrLf & "werden verarbeitet! Zum Abbrechen Strg+Pause drücken.")
    ChDir (DataDir)
    nextfile = Dir("*.XLS")
    MsgBox (nextfile) 'temporary Checkpoint
    j = 0
    While nextfile <> ""
        j = j + 1
        file = DataDir & "\" & nextfile
        newFile = DataDir & "\OUT\" & nextfile
        MsgBox (file & " -> " & newFile) 'temporary Checkpoint
        Open file For Input As #1
        Open newFile For Output As #2
        Do While Not EOF(1)
            Line Input #1, textline
            lines = Split(textline, vbNewLine)
            For i = 0 To UBound(lines)
                If i = 0 Then
                    words = Split(lines(i), vbTab)
                    words(16) = words(4)
                    Print #2, Join(words, vbTab)
                Else
                    Print #2, lines(i)
                End If
            Next i
        Loop
        Close #1
        Close #2
        
        nextfile = Dir()
    Wend
    MsgBox ("Insgesamt " & j & " Dateien wurden verarbeitet.")
End Sub

For some reason, rather than only altering one line, it changes each line of every file (which I don't really understand at all looking at the code):

Original:

enter image description here

Altered file:

enter image description here


UPDATE 2 - FINAL RESULT

Sub processFiles()
    Dim bFirstLine As Boolean
    Dim file As String, newFile As String
    Dim words() As String
    Dim i As Integer
    
    DataDir = "c:\test"
    ChDir (DataDir)
    If Dir(DataDir & "\OUT", vbDirectory) = "" Then
        MkDir DataDir & "\OUT"
    End If
    nextfile = Dir("*.XLS")
    While nextfile <> ""
        If (Right(nextfile, 4)) = ".XLS" Then
            file = DataDir & "\" & nextfile
            newFile = DataDir & "\OUT\" & nextfile
            bFirstLine = True
            Open file For Input As #1
            Open newFile For Output As #2
            Do While Not EOF(1)
                Line Input #1, textline
                If bFirstLine Then
                    words = Split(textline, vbTab)
                    words(16) = words(4)
                    Print #2, Join(words, vbTab)
                    bFirstLine = False
                Else
                    Print #2, textline
                End If
            Loop
            Close #1
            Close #2
        End If
        nextfile = Dir()
    Wend
End Sub
Dreamingof8a
  • 127
  • 11

1 Answers1

1

If I were right, your system only can process text file with TAB delimited. Then you don't have to convert it into xls. It is covnient to get it done w/o conversion.

Sub ProcessFile()
    Dim file As String, newFile As String
    Dim words() As String
    Dim i As Integer, bFirstLine As Boolean
    file = "d:\temp\src\H70000-18681.XLS"
    newFile = "d:\temp\src\new.txt"
    bFirstLine = True
    Open file For Input As #1
    Open newFile For Output As #2
    Do While Not EOF(1)
        Line Input #1, textline
        If bFirstLine Then
            words = Split(textline, vbTab)
            words(16) = words(4)
            Print #2, Join(words, vbTab)
            bFirstLine = False
        Else
            Print #2, textline
        End If
    Loop
    Close #1
    Close #2
End Sub

enter image description here

taller_ExcelHome
  • 2,232
  • 1
  • 2
  • 12
  • Thanks for the answer - it's working, except that it processes all lines in my case and I need to process an entire folder of files rather than one, but when I try to combine my script with yours I get errors such as mismatching types :( – Dreamingof8a Aug 11 '23 at 10:57
  • Please clarify what's kind of file is loaded into your system, xls or txt(csv)? Please share your code in OP and provide the detail for errors. – taller_ExcelHome Aug 11 '23 at 14:36
  • Sorry for the late reply, I was on vacation. I added my version of your code to the OP - I really don't understand why in my case it is processing more than the first line ... And yes, I'm pretty sure it's tab-stopp delimited CSV files. I uploaded some examples to https://drive.google.com/drive/folders/1RmVPm53C_ZXIlMIJn8zLiFRsaXhBHnly?usp=drive_link – Dreamingof8a Aug 28 '23 at 14:02
  • I have updated the code. – taller_ExcelHome Aug 28 '23 at 15:22
  • Thanks a lot - it's working. Still a bit confused tho why it seemed to work in your example (see your screenshots). But anyway, thanks again! – Dreamingof8a Aug 28 '23 at 15:30