重新打开时,CSV中的前导零

时间:2013-06-10 04:15:48

标签: excel vba csv excel-vba

我有txt文件,如下所示

enter image description here

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

enter image description here

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

enter image description here

问题是重新打开csv文件如下所示。帐户列中的前导零消失。我无法在系统不接受的帐户列单元格bcoz前面添加'。可以做些什么来保持csv open / reopen上的前导零?

enter image description here 我这样做都是使用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

1 个答案:

答案 0 :(得分:2)

这是MS Excel中的一个不幸的问题。除了更改格式和使用xls之外,我找不到任何方法。我从csv文件向我的桌面应用程序提供数据,任何人都可以编辑。不幸的是,尽管我尝试了各种各样的东我找到的唯一可靠的方法是在数字!00101之前有一个!以便它被接受为字符串。这对于应用程序来说是可以的(它可以取代!没有任何东西),但仍然会影响人类的可读性因素。

根据您的应用和使用情况,您可能必须使用其他格式。