Как я могу экспортировать из файла Excel в файл CSV файл с начальными нулями в текстовом формате?

Question

У меня есть эта проблема:

Sub GravarArquivoCSV()

Open Range("E1").Value For Output As 1

Sheets("APR_CSV").Activate
Range("A1").Select

Do While ActiveCell.Text <> ""
    Print #1, ActiveCell.Value & ";" & Cells(ActiveCell.Row, 2).Value & ";" & Cells(ActiveCell.Row, 3).Value & ";" & Cells(ActiveCell.Row, 4).Value
    Cells(ActiveCell.Row + 1, ActiveCell.Column).Select
Loop

MsgBox "Arquivo gerado com sucesso!", vbInformation, "OK"
Close 1

Sheets("Autoline Controlo Compras").Activate
End Sub

Но вся информация стала без левых нулей в сгенерированном выходе CSV:

Предназначено:

62013227 001148160R 1 41563 M02-UL-98
62013227 8200212598 2 42426 M25-BI-26
62013227 0000066444 1 42490 C19-RA-68
62013227 8200725845 1 43858 BJ1 0028 11485
62013227 7701475837 1 43858 BJ1 0028 11485
62013227 0000474796 1 43858 BJ1 0028 11485
62013227 8200661217 2 43858 BJ1 0028 11485

CSV Export: Без необходимого левого ZERO 000

62013227 001148160R 1 41563 M02-UL-98
62013227 8200212598 2 42426 M25-BI-26
62013227 66444 1 42490 C19-RA-68
62013227 8200725845 1 43858 BJ1 0028 11485
62013227 7701475837 1 43858 BJ1 0028 11485
62013227 474796 1 43858 BJ1 0028 11485
62013227 8200661217 2 43858 BJ1 0028 11485

Как я могу исправить этот код VBA, чтобы иметь начальные нули?

Answer 1

Экспорт

Если вам нужны начальные нули, тогда Формат должен помочь.

Вам также следует избегать выбора или активации чего-либо .
Поэтому я использовал переменную "i" для цикла по всем строкам.

Поскольку номер файла 1, возможно, уже используется, лучше использовать FreeFile.

Sub GravarArquivoCSV()
    Dim fileNum As Long
    Dim i As Long

    fileNum = FreeFile
    Open Range("E1").Value For Output As fileNum

    With Sheets("APR_CSV")
        i = 1
        Do While .Cells(i, "A").Text <> ""
            Print #FileNum, .Cells(i, "A").Value & ";" & _
                      Format(.Cells(i, "B").Value, "0000000000") & ";" & _
                      .Cells(i, "C").Value & ";" & _
                      .Cells(i, "D").Value
            i = i + 1
        Loop
    End With
    Close fileNum

    MsgBox "Arquivo gerado com sucesso!", vbInformation, "OK"
    Sheets("Autoline Controlo Compras").Activate
End Sub

---

Импорт

Когда вы импортируете этот CSV в Excel, Excel распознает числа как числа.
Поэтому у вас есть два варианта:

• сохранить его как число и присвоить ему индивидуальный числовой формат,
  е. г. «0000000000» показывает числа с ведущими нулями
• импортировать его как текстовую строку, следуя коду VBA

Пожалуйста, адаптируйте путь к файлу и имя файла под свои нужды.

Public Sub ImportCSV()
    Dim wb As Workbook
    Set wb = Application.Workbooks.Add

    With wb.Worksheets(1).QueryTables.Add( _
        Connection:="TEXT;" & Application.DefaultFilePath & "\APR_CSV.csv", _
        Destination:=wb.Worksheets(1).Range("A1"))
        .Name = "APR_CSV"
        .FieldNames = False
        .RowNumbers = False
        .FillAdjacentFormulas = False
        .PreserveFormatting = True
        .RefreshOnFileOpen = False
        .RefreshStyle = XlCellInsertionMode.xlInsertDeleteCells
        .SavePassword = False
        .SaveData = True
        .AdjustColumnWidth = True
        .RefreshPeriod = 0
        .TextFilePromptOnRefresh = False
        .TextFilePlatform = XlPlatform.xlWindows
        .TextFileStartRow = 1
        .TextFileParseType = XlTextParsingType.xlDelimited
        .TextFileTextQualifier = XlTextQualifier.xlTextQualifierNone
        .TextFileConsecutiveDelimiter = False
        .TextFileTabDelimiter = False
        .TextFileSemicolonDelimiter = True
        .TextFileCommaDelimiter = False
        .TextFileSpaceDelimiter = False
        .TextFileColumnDataTypes = Array( _
            XlColumnDataType.xlGeneralFormat, _
            XlColumnDataType.xlTextFormat, _
            XlColumnDataType.xlGeneralFormat, _
            XlColumnDataType.xlTextFormat)
        .TextFileDecimalSeparator = "."
        .TextFileThousandsSeparator = ","
        .TextFileTrailingMinusNumbers = True
        .Refresh BackgroundQuery:=False
        .Delete
    End With
End Sub

---

Путь к файлу Excel

Пожалуйста, используйте ActiveWorkbook, который является текущим активным файлом, или ThisWorkbook, который является файлом с вашим кодом VBA. Они одинаковы, если файл, содержащий ваш код VBA, также является активным файлом.

Используйте его Path, добавьте обратную косую черту "\" и добавьте желаемое имя файла CSV (например, "APR CSV Renault.CSV").

Эксперимент со своим:

Private Sub DebugMyPaths
' always the file with THIS VBA code:
Debug.Print ThisWorkbook.Path & "\" & ThisWorkbook.Name
Debug.Print ThisWorkbook.FullName

' always the active Excel file:
Debug.Print ActiveWorkbook.Path & "\" & ActiveWorkbook.Name
Debug.Print ActiveWorkbook.FullName
End Sub