zero iniziale in formato CSV su riaprire

Question

Ho file che è simile di seguito

Sto importando il file txt in excel con il metodo indicato here txt. L'account colonna viene convertito in testo.

Una volta che i dati vengono importati, il file si presenta come di seguito. Ho il requisito di salvare il file come csv che viene quindi importato da un sistema diverso.

Il problema è sulla riaprire il file CSV si presenta come di seguito. Lo zero iniziale nella colonna dell'account scompare. Non riesco ad aggiungere ' davanti alle celle della colonna Account bcoz che il sistema non accetta. Cosa si può fare per preservare lo zero iniziale su csv open/riaprire?

io sto facendo tutto questo utilizzando 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

Questo è un problema sfortunato in MS Excel. Non ho potuto trovare alcun modo per aggirare questo, tranne per cambiare il formato e utilizzare xls. Stavo fornendo dati alla mia applicazione desktop da un file CSV che poteva essere modificato da chiunque. Sfortunatamente, il problema dello zero principale è rimasto nonostante le varie cose che ho provato. L'unico metodo affidabile che ho trovato era avere un! Prima del numero! 00101 in modo che fosse accettato come una stringa. Questo andava bene per l'applicazione (poteva sostituire il! Con niente), ma il fattore di leggibilità umano era comunque influenzato.

In base all'applicazione e all'uso, potrebbe essere necessario utilizzare un formato diverso.