我有 txt 文件，如下所示
我正在使用此处显示的方法在 excel 中导入 txt 文件。列帐户转换为文本。
导入数据后，文件如下所示。我需要保存文件csv，然后由不同的系统导入。
问题在于重新打开 csv 文件，如下所示。帐户列中的前导零消失。我无法'在帐户列单元格前面添加，因为系统不接受。可以做些什么来保留 csv open/reopen 的前导零？
我正在使用 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