Сохранение .txt как .csv отменяет все изменения, сделанные макросом в файле.Как это предотвратить?

Question

Проблема продолжается эта тема и связана с моим предыдущим постом .Код должен работать с файлами .csv, меняющими значения ячеек и цвет интерьера.Это делает свою работу, но после сохранения .txt как .csv я получаю что-то похожее на исходный файл - никаких изменений не видно.

Я думал об использовании словарей, но, насколько я понимаю, для этого,Мне пришлось отредактировать недавно сохраненный .csv, чего я и стараюсь избегать в приведенном ниже коде.У кого-нибудь есть идеи как сохранить изменения?

Option Explicit

Sub fixCellsValue()
Dim wrk As Workbook
Dim Sh As Worksheet
Dim SourceFolder As String, Path As String, TmpFlName As String
Dim i As Long, lastrow As Long

SourceFolder = ThisWorkbook.Path & "\source"

'creating temporary .txt file
If Dir(SourceFolder & "SomeFile.*") <> "" Then
    If InStr(1, Dir(SourceFolder & "SomeFile.*"), ".csv") Then
                    TmpFlName = SourceFolder & "\TmpCsv.txt"
                    If Dir(TmpFlName) <> "" Then Kill TmpFlName
                    FileCopy SourceFolder & "SomeFile.csv", TmpFlName
                    Workbooks.OpenText Filename:=TmpFlName, origin:= _
                    1250, StartRow:=1, DataType:=xlDelimited, TextQualifier:=xlDoubleQuote, _
                    ConsecutiveDelimiter:=False, Tab:=False, Semicolon:=True, Comma:=False _
                    , Space:=False, Other:=False, TrailingMinusNumbers:=True, Local:=False

                    Set wrk = Application.Workbooks("TmpCsv.txt")
                    Set Sh = wrk.Worksheets(1)

        lastrow = Sh.Cells(Sh.Rows.Count, "A").End(xlUp).row

        'implementing changes to the temporary .txt file
        For i = 2 To lastrow
            If Len(Sh.Cells(i, 5)) > 10 Then
                Sh.Cells(i, 5) = Left$(Sh.Cells(i, 5).Value, 10)
                Sh.Cells(i, 5).Interior.ColorIndex = 6
            End If
        Next i

    End If
End If

'saving as .csv file and deleting .txt file
If InStr(1, wrk.Name, "TmpCsv.txt") Then
    wrk.SaveAs Filename:=Dir(SourceFolder & "SomeFile.*"), FileFormat:=xlCSV, Local:=True
    wrk.Close Savechanges:=True
    Kill TmpFlName
End If
End Sub

Answer 1

То, что в вашем более раннем посте выглядело как простой открывающий текст / cvs файл с разделителями точкой с запятой, теперь выглядит сложным.Даже не обращая внимания на другие проблемы, в моем испытании я обнаружил, что при сохранении файлов txt / csv из excel может появиться двойная кавычка в сохраненном файле (в зависимости от положения запятой, пробелов и точки с запятой в строке).Может ссылаться на ссылки ( Сохранение файла Excel в формате .txt без кавычек ) и ссылка и ссылка2

Как я понимаю, ваше требованиепросто обрезать 5-й столбец файла, разделенного точкой с запятой, с расширением csv и сохранить его обратно, простой подход может решить вашу проблему.Однако я все еще не удовлетворен обходным подходом и приглашаю более простой и прямой подход для решения проблемы m (состоящий из файла txt с запятой, пробелами и точками с запятой, в то время как точка с запятой должна рассматриваться как разделитель)

Попробуйте

Sub test2()
Dim Fname As String, Path As String, Txt As String, Txt2 As String
Dim INum As Integer, ONum As Integer, TrucTo As Integer, ColNo As Long
Dim Cols As Variant

' Modify the variables to your requirement
Path = "C:\Users\user\Desktop\"
Fname = "Somefile.csv"     ' Target file name
Fname2 = "Somefile2.csv"   ' Temp file name
TrucTo = 10                ' truncated to chars
ColNo = 4                   '  column to be truncated -1

If Dir(Path & Fname2) <> "" Then Kill Path & Fname2


INum = FreeFile
Open Path & Fname For Input As #INum
ONum = FreeFile
Open Path & Fname2 For Output As #ONum

Do Until EOF(1)
    Line Input #1, Txt
    Cols = Split(Txt, ";")
        If UBound(Cols) >= ColNo Then
            If Len(Cols(ColNo)) >= truncto Then
            Cols(ColNo) = Left(Cols(ColNo), TrucTo)
            End If
        End If
    Txt2 = Join(Cols, ";")
    Print #ONum, Txt2
Loop
Close #ONum
Close #INum


Kill Path & Fname
Name Path & Fname2 As Path & Fname


End Sub

Это результат ввода и вывода