用于使用VBA导入固定宽度文本文件的Excel宏

目前我正在使用此代码导入、删除文本文件并将其转换为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。当调用该文件时，它应该首先以文件_1为目标，然后仅以文件_2为目标，但代码不是这样做，而是先获取文件_2，然后跳过文件_1

而且输出并不像预期的那样，因为列宽在每个文件之间总是变化，这会导致内容被拆分为不同的列。我从先前录制的宏中获取的所有过程发生的部分

有没有办法根据文本文件更改列宽？我如何使代码选择位置中的第一个文件而不是第二个文件

请帮帮我

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

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）

因为这些是我制作宏以确定列宽度所需的部分。但我不知道

“SpanSpaces”

和

“ImpDataTypes”

有什么作用，它们有什么用途，但我认为这只是前面声明的一个变体。我有没有办法修改这两行代码，使之适合我当前的一行

我找到这段代码的全部代码和帖子都可以在这里找到：

---

如果“列宽在每个文件之间总是变化”，则显然不能使用固定宽度格式。使用除逗号外所有分隔符都关闭的分隔格式。感谢您指出这一部分，我注意到，

.TextFileColumnDataTypes=Array（1,1,1,1,1,1,1,1）

.TextFileFixedColumnWidths=Array（7,22,100,14,12,11,21,20）

是导致整个事情变得混乱的原因。但我之所以使用固定字段，是因为我导入的文件不包含任何类型的分隔符，如逗号、空格甚至制表符。因此，如果没有分隔符，并且没有文件保证为固定宽度格式，那么您必须有解析策略？例如，如果每一行的内容都是RedOrangeYellowGreenBlueIndigoViolet，那么你可以说你想用大写字母拆分这一行。什么是

GetFileList

？是每个文件的列宽不同，但您知道每个文件的列宽是多少，还是它们都是随机的未知宽度？如果是第二个，则很难自动化此过程。只要您知道宽度是多少，就可以使用

If-Else

，直接选择

FixedColumnWidths

。或者，如果它总是像您的示例一样，那么像

Array（，Array（7，22，100），Array（9，12，102））（Right（TFArray，1））

也可以。