Excelmacros，用于使用VBA导入具有固定宽度的文本文件

目前我正在使用此代码导入，删除和转换文本文件为CSV文件。 而且我自动完成所有这些工作，同时针对文件位置和输出位置。 代码如下：

Option Explicit Sub DataConversion() Dim directory As String, FileName As String, file As Object, i As Integer, j As Integer, fso As Object, c As Integer, MyFile As String, Content As String, textline As String, TextFileArray As Variant Dim Path As String, TextFile As Integer, TotalFile As Integer, TFArray As String Application.ScreenUpdating = False Application.DisplayAlerts = False directory = "C:\Users\Edward\Desktop\Extracted Data\Text File" FileName = Dir(directory & "*.txt") Set fso = CreateObject("Scripting.FileSystemObject") Set file = fso.GetFolder(directory).Files MyFile = "C:\Users\Edward\Desktop\Extracted Data\Text File\*.txt" TextFileArray = GetFileList(MyFile) TotalFile = file.Count Select Case IsArray(TextFileArray) Case True For i = LBound(TextFileArray) To UBound(TextFileArray) TFArray = TextFileArray(i) TFArray = Replace(TFArray, ".txt", "") ActiveSheet.Cells.ClearContents With ActiveSheet.QueryTables.Add(Connection:= _ "TEXT;C:\Users\Edward\Desktop\Extracted Data\Text File\" + TextFileArray(i), _ Destination:=Range("$A$1")) .Name = TFArray .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 = xlFixedWidth .TextFileTextQualifier = xlTextQualifierDoubleQuote .TextFileConsecutiveDelimiter = False .TextFileTabDelimiter = True .TextFileSemicolonDelimiter = False .TextFileCommaDelimiter = False .TextFileSpaceDelimiter = False .TextFileColumnDataTypes = Array(1, 1, 1, 1, 1, 1, 1, 1, 1) .TextFileFixedColumnWidths = Array(7, 22, 100, 14, 12, 11, 21, 20) .TextFileTrailingMinusNumbers = True .Refresh BackgroundQuery:=False End With Rows("2:2").Select Selection.Delete Shift:=xlUp ActiveWorkbook.Save ChDir "C:\Users\Edward\Desktop\Extracted Data\CSV File" ActiveSheet.SaveAs FileName:= _ "C:\Users\Edward\Desktop\Extracted Data\CSV File\" + TFArray + ".csv", FileFormat:= _ xlCSV, CreateBackup:=False Dim wb_connection As WorkbookConnection For Each wb_connection In ActiveWorkbook.Connections If InStr(TextFileArray(i), wb_connection.Name) > 0 Then wb_connection.Delete End If Next wb_connection Next i Case False MsgBox "No matching files" End Select Application.ScreenUpdating = True Application.DisplayAlerts = True End Sub 

代码运行良好，但它取代了文件1，例如：File_1，File_2，File_3。 当它调用文件时，它应该首先定位File_1，然后定位File_2，而不是先执行File_2，然后跳过File_1。

而且输出不像预期的那样，因为列宽在每个文件之间总是变化，并且导致内容被分成不同的列。 我从之前logging的一个macros中获取所有过程的部分。

有没有办法让列宽根据文本文件改变？ 我该如何让代码select位置中的第一个文件而不是第二个文件？

请帮帮我。

编辑：每个文件的列的宽度是我不知道的，因为有大约300多个文件，我需要转换。 但是我发现有一种方法可以使用Transpose函数来检测列的宽度。 find的代码如下所示：

 Dim WB As Workbook Dim odWS As Worksheet Dim fsuWS As Worksheet Dim fd As FileDialog Dim fcInt As Integer Dim fcStr As String Dim spAr As Variant Dim dtAr As Variant Set WB = ThisWorkbook Set odWS = WB.Sheets.Add odWS.Name = "OriginalData" Set fsuWS = WB.Sheets("FieldSetUp") 'Transposing the range is essential for loading the values to the 'Array properties below spAr = Application.Transpose(fsuWS.Range("SpanSpaces").Value) dtAr = Application.Transpose(fsuWS.Range("ImpDataTypes").Value) 

感兴趣的部分是spAr = Application.Transpose(fsuWS.Range("SpanSpaces").Value)和dtAr = Application.Transpose(fsuWS.Range("ImpDataTypes").Value)因为这些是我需要的部分对于我来说，使macros来确定列的宽度。 但是我不知道"SpanSpaces"和"ImpDataTypes"做什么的，它们的用途是什么，但是我认为它只是一个已经被声明的Variant。 有没有办法让我改变这两行代码，使其适合我目前的？

整个代码和post，我发现这个代码可以在这里find： http : //www.mrexcel.com/forum/excel-questions/676605-fill-array-property-range-variable.html