Question

目前我正在使用此代码导入，删除文本文件并将其转换为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。

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

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

请帮帮我。

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

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"做了什么以及它们的用途是什么，但我认为它只是之前已经声明过的变体。有没有办法让我更改这两行代码以使其适合我当前的代码？

我发现此代码的完整代码和帖子可以在这里找到： http://www.mrexcel.com/forum/excel-questions/676605-fill-array-property-range-variable.html

用于使用VBA

0 个答案: