vba 重新打开时在 CSV 中领先零

Leading zero in CSV on reopen

提问by Santosh

I have txt file which looks like below

我有一个 txt 文件，如下所示

I am importing the txt file in excel using the method shown here. Column Account is converted to text.

我正在使用此处显示的方法在 excel 中导入 txt 文件。列帐户转换为文本。

Once the data is imported, file looks like below. I have a requirement to save the file as csvwhich is then imported by different system.

导入数据后，文件如下所示。我需要将文件另存为csv，然后由不同的系统导入。

The problem is on reopen the csv file looks like below. The leading zero in account column disappears. I cannot add 'in front of Account column cells bcoz the system does not accepts. What can be done to preserve the leading zero on csv open/ reopen ?

问题在于重新打开 csv 文件，如下所示。帐户列中的前导零消失。'由于系统不接受，我无法在 Account 列单元格前面添加。可以做些什么来保留 csv 打开/重新打开时的前导零？

I m doing this all using vba

我正在使用 vba 做这一切

Sub createcsv()

    Dim fileName As String
    Dim lastrow As Long
    Dim wkb As Workbook

    lastrow = Range("C" & Rows.Count).End(xlUp).Row
    'If lastrow < 6 Then lastrow = 6


    For i = lastrow To 3 Step -1

        If Cells(i, 4).Text = vbNullString Then
            Cells(i, 1).EntireRow.Delete
        ElseIf Trim(Cells(i, 4).Value) = "-" Then
            Cells(i, 1).EntireRow.Delete
        ElseIf Cells(i, 4).Value = 0 Then
            Cells(i, 1).EntireRow.Delete
        ElseIf CDbl(Cells(i, 4).Text) = 0 Then
            Cells(i, 1).EntireRow.Delete
        End If
    Next


    lastrow = Range("C" & Rows.Count).End(xlUp).Row
    'If lastrow < 6 Then lastrow = 6


    retval = InputBox("Please enter journal Id", Default:="G")
    Range("A3:A" & lastrow) = retval

    retval = InputBox("Please enter Date", Default:=Date)
    Range("B3:B" & lastrow) = retval

    retval = InputBox("Please enter description", Default:="Master entry")
    Range("E3:E" & lastrow) = retval


    Dim strVal As String
    strVal = InputBox("Please enter File Name", Default:="Data")

    filePath = CreateFolder(strVal)
    fileName = GetFileName(filePath)

    ThisWorkbook.Sheets("Sheet1").Copy
    Set wkb = ActiveWorkbook
    Set sht = wkb.Sheets("sheet1")

    Application.DisplayAlerts = False
    wkb.SaveAs fileName:=filePath, FileFormat:=xlCSV

    sht.Cells.Clear
    importTxt wkb, filePath, fileName

    sht.Columns("A:A").NumberFormat = "General"
    sht.Columns("B:B").NumberFormat = "M/d/yyyy"
    sht.Columns("D:D").NumberFormat = "0.00"
    sht.Columns("E:E").NumberFormat = "General"


    wkb.SaveAs fileName:=Replace(filePath, ".txt", ".csv"), FileFormat:=xlCSV
    wkb.Close
    Set wkb = Nothing

    Application.DisplayAlerts = True
err_rout:
    Application.EnableEvents = True
End Sub



Function CreateFolder(Optional strName As String = "Data") As String

    Dim fso As Object, MyFolder As String
    Set fso = CreateObject("Scripting.FileSystemObject")

    MyFolder = ThisWorkbook.Path & "\Reports"


    If fso.FolderExists(MyFolder) = False Then
        fso.CreateFolder (MyFolder)
    End If

    MyFolder = MyFolder & "\" & Format(Now(), "MMM_YYYY")

    If fso.FolderExists(MyFolder) = False Then
        fso.CreateFolder (MyFolder)
    End If

    CreateFolder = MyFolder & "\" & strName & Format(Now(), "DD-MM-YY hh.mm.ss") & ".txt"
    Set fso = Nothing

End Function

Sub importTxt(ByRef wkb As Workbook, ByVal txtLink As String, ByVal fileName As String)

    With wkb.Sheets(fileName).QueryTables.Add(Connection:= _
                                              "TEXT;" & txtLink, _
                                              Destination:=Range("$A"))
        .Name = fileName
        .FieldNames = True
        .RowNumbers = False
        .FillAdjacentFormulas = False
        .PreserveFormatting = True
        .RefreshOnFileOpen = False
        .RefreshStyle = xlInsertDeleteCells
        .SavePassword = False
        .SaveData = True
        .AdjustColumnWidth = True
        .RefreshPeriod = 0
        .TextFilePromptOnRefresh = False
        .TextFilePlatform = 437
        .TextFileStartRow = 1
        .TextFileParseType = xlDelimited
        .TextFileTextQualifier = xlTextQualifierDoubleQuote
        .TextFileConsecutiveDelimiter = False
        .TextFileTabDelimiter = False
        .TextFileSemicolonDelimiter = False
        .TextFileCommaDelimiter = True
        .TextFileSpaceDelimiter = False
        .TextFileColumnDataTypes = Array(1, 1, 2, 1, 1)
        .TextFileTrailingMinusNumbers = True
        .Refresh BackgroundQuery:=False
    End With
End Sub

Function GetFileName(ByVal fullName As String, Optional pathSeparator As String = "\") As String
'?sheet1.GetFileName( "C:\Users\Santosh\Desktop\ssss.xlsx","\")

    Dim i As Integer
    Dim tempStr As String
    Dim iFNLenght As Integer
    iFNLenght = Len(fullName)

    For i = iFNLenght To 1 Step -1
        If Mid(fullName, i, 1) = pathSeparator Then Exit For
    Next

    tempStr = Right(fullName, iFNLenght - i)
    GetFileName = Left(tempStr, Len(tempStr) - 4)

End Function

回答by SoWhat

This is an unfortunate problem in MS Excel. I could not find any way around this, except to change the format and use xls. I was supplying data to my desktop application from a csv file that could be edited by anyone. Unfortunately, the leading zero problem stayed despite various things I tried. The only reliable method I found was to have a !before the number !00101 so that it was accepted as a string. This was okay for the application(it could replace the ! with nothing), but still the human readability factor was affected.

这是 MS Excel 中的一个不幸问题。除了更改格式并使用 xls 之外，我找不到任何解决方法。我从一个任何人都可以编辑的 csv 文件向我的桌面应用程序提供数据。不幸的是，尽管我尝试了各种方法，但前导零问题仍然存在。我发现的唯一可靠的方法是在数字 !00101 之前加上一个 ! 以便它被接受为字符串。这对应用程序来说没问题（它可以用任何东西代替 !），但人类可读性因素仍然受到影响。

Depending on your application and use, you might have to use a different format.

根据您的应用程序和用途，您可能必须使用不同的格式。