我正在尝试将多个txt文件导入excel。该代码可以正常运行，但会弄乱日期和数字格式。例如，对于大于1000的数字，它省略零。我尝试了另一篇文章中描述的解决方案：Excel VBA - Importing multiple txt files but not able to convert data to text format使用FieldInfo来解决显示此类格式问题的列（第18、62、63、64、65列），但仍然无法正常工作。这是我正在使用的原始代码。
Sub Extract()
Dim FilesToOpen
Dim x As Integer
Dim wkbAll As Workbook
Dim sDelimiter As String
On Error GoTo ErrHandler
Application.ScreenUpdating = False
sDelimiter = "|"
FilesToOpen = Application.GetOpenFilename _
(FileFilter:="Text Files (*.txt), *.txt", _
MultiSelect:=True, Title:="Text Files to Open")
If TypeName(FilesToOpen) = "Boolean" Then
MsgBox "No Files were selected"
GoTo ExitHandler
End If
Set wkbAll = Application.ActiveWorkbook
x = 1
With Workbooks.Open(Filename:=FilesToOpen(x))
.Worksheets(1).Columns("A:A").TextToColumns _
Destination:=Range("A1"), DataType:=xlDelimited, _
TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, _
Tab:=False, Semicolon:=False, Comma:=False, Space:=False, _
Other:=True, OtherChar:="|", FieldInfo:=Array(Array(18, 2), Array(62, 2), Array(63, 2), Array(64, 2), Array(65, 2)), TrailingMinusNumbers:=True
.Sheets(1).Copy After:=ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count)
.Close False
End With
x = x + 1
While x <= UBound(FilesToOpen)
With Workbooks.Open(Filename:=FilesToOpen(x))
.Worksheets(1).Columns("A:A").TextToColumns _
Destination:=Range("A1"), DataType:=xlDelimited, _
TextQualifier:=xlDoubleQuote, _
ConsecutiveDelimiter:=False, _
Tab:=False, Semicolon:=False, _
Comma:=False, Space:=False, _
Other:=True, OtherChar:=sDelimiter, FieldInfo:=Array(Array(18, 2), Array(62, 2), Array(63, 2), Array(64, 2), Array(65, 2)), TrailingMinusNumbers:=True
.Sheets(1).Move After:=ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count)
End With
x = x + 1
Wend
wkbAll.Save
ExitHandler:
Application.ScreenUpdating = True
Set wkbAll = Nothing
Exit Sub
ErrHandler:
MsgBox Err.Description
Resume ExitHandler
End Sub
更新 我还找到了一个实际上可以解决数据格式错误的代码，但这仅用于导入1个文件。 我需要类似的东西，但要导入39个txt文件，所有文件都具有相同的结构：大约70列，其中大多数为字符串，除了3个数字和1个日期（这些最后一个导致麻烦）。有什么帮助吗？预先感谢。
Sub importCSV()
Dim ans As Integer:
ans = MsgBox("Click OK then select the file to import " & vbNewLine & "Data will be imported at position of active cell", vbOKCancel)
If ans = vbCancel Then
GoTo exitpoint
End If
'data will be imported at position of active cell as first data element
Dim ColumnsType() As Variant
strFilepath = Application.GetOpenFilename() 'prompt user for filepath of import file
If strFilepath = False Then Exit Sub
Dim intFileNo As Integer
Dim nCol As Long
Dim strLine As String
Dim varColumnFormat As Variant
Dim varTemp As Variant
' Read first line of file to figure out how many columns there are
intFileNo = FreeFile()
Open strFilepath For Input As #intFileNo
Line Input #intFileNo, strLine
Close #intFileNo
varTemp = Split(strLine, ",")
nCol = UBound(varTemp)
ReDim varColumnFormat(0 To nCol)
' get the columns to import as Text from user
Dim textit() As String
textit = Split(InputBox("Enter columns to format as Text (e.g 1,3,5)" & Chr(10) & Chr(10) & "Or OK/Cancel to use file definition"), ",")
ub = UBound(textit)
If ub = -1 Then 'if nothing entered, promp for file for column formats
Dim strFilename2 As String: strFilename2 = Application.GetOpenFilename()
If strFilename2 = "" Or strFilename2 = "False" Then
MsgBox "No column Types have been entered." & Chr(10) & "Exiting Sub.", vbExclamation
Exit Sub
End If
Dim strFileContent As String
Dim iFile As Integer: iFile = FreeFile
Open strFilename2 For Input As #iFile
strFileContent = Input(LOF(iFile), iFile)
Close #iFile
textit = Split(strFileContent, ",")
ub = UBound(textit)
If ub < nCol Then 'confirm there are enough column denoted in the file
MsgBox "There are too few columns denoted in your column format file." & Chr(10) & "Exiting Sub.", vbExclamation
Exit Sub
End If
For i = 0 To nCol 'assing the file values to the column format array
varColumnFormat(i) = Int(textit(i))
Next
Else 'assign the entered columns a Text format value in the column format array
Dim uBi As Integer
uBi = 0
For i = 0 To nCol
If i + 1 = textit(uBi) Then
varColumnFormat(i) = xlTextFormat
uBi = WorksheetFunction.Min(uBi + 1, ub)
Else
varColumnFormat(i) = xlGeneralFormat
End If
Next
End If
With ActiveWorkbook.ActiveSheet.QueryTables.Add(Connection:="TEXT;" & strFilepath, Destination:=ActiveCell) 'creates the query to import the CSV. All following lines are properties of this
.PreserveFormatting = False
.RefreshStyle = xlOverwriteCells
.AdjustColumnWidth = True
.TextFileParseType = xlDelimited
.TextFileOtherDelimiter = Application.International(xlListSeparator) 'uses system setting => EU countries = ';' and US = ','
.TextFileColumnDataTypes = varColumnFormat 'set column data types as input by user
.Refresh BackgroundQuery:=False 'this is neccesary so a second import can be done
End With
ActiveWorkbook.ActiveSheet.QueryTables(1).Delete 'deletes the query
MsgBox "Date Import Done!"
exitpoint:
End Sub
答案 0 :(得分：1)
您的问题是从文本文件中提取数据时的数据类型。您需要将18, 2更改为18, 1
Number Format
1 Text
2 General
3 I think this means skip?
4 Date
因此，您需要将FieldInfo:=Array(Array(18, 2), Array(62, 2), Array(63, 2), Array(64, 2), Array(65, 2))更改为所需的数据类型。文字最适合我认为 7 个数字的数字。在日期列中使用日期，但您需要检查其格式是否正确
所以，如果下面所有的都是数字，最后一个是日期，则看起来像这样
While x <= UBound(FilesToOpen)
With Workbooks.Open(Filename:=FilesToOpen(x))
.Worksheets(1).Columns("A:A").TextToColumns _
Destination:=Range("A1"), DataType:=xlDelimited, _
TextQualifier:=xlDoubleQuote, _
ConsecutiveDelimiter:=False, _
Tab:=False, Semicolon:=False, _
Comma:=False, Space:=False, _
Other:=True, OtherChar:=sDelimiter, FieldInfo:=Array(Array(18, 1), Array(62, 1), Array(63, 1), Array(64, 1), Array(65, 4)), TrailingMinusNumbers:=True
.Sheets(1).Move After:=ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count)