Leading zero in CSV on reopen [duplicate]

Question

I have txt file which looks like below

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

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

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 ?

I m doing this all using 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$2"))
        .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

Answer 1

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.

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