Excel VBA導入可變列寬度的TXT文件

Question

我通過VBA將固定文件（TXT）導入到Excel中有一個難題。問題並不是真正將數據導入Excel（下面的代碼），而是根據TXT文件的列內容更改列寬。

任何幫助是非常appriciated！

實施例：

TXT文件的內容是：

FirstC  SecondC   ThirdC 
A    111122223333  444455556666 
B    111122223333  444455556666 
A    111122223333  444455556666 
A    111122223333  444455556666 
B    111122223333  444455556666 

取決於第一列（FirstC）在Excel中導入列的寬度應改變的內容，即用於A中的列第二列（SecondC）的寬度應爲8位數字，並在B的情況下，它應該是10個位數

導入代碼（不是親，很抱歉，如果代碼是有點雜亂）：

Sub Button1_Click() 

Dim vPath As Variant 

vPath = Application.GetOpenFilename("TextFiles (*.txt), *.txt", , "TEST TEXT IMPORTER:") 
If vPath = False Then Exit Sub 
Filename = vPath 
Debug.Print vPath 

Worksheets("IMPORT").UsedRange.ClearContents 


With Sheets("IMPORT").QueryTables.Add(Connection:="TEXT;" & CStr(vPath), Destination:=Sheets("IMPORT").Range("A2")) 
     .FieldNames = True 
     .RowNumbers = False 
     .FillAdjacentFormulas = False 
     .PreserveFormatting = True 
     .RefreshOnFileOpen = False 
     .RefreshStyle = xlInsertDeleteCells 
     .SavePassword = False 
     .SaveData = True 
     .AdjustColumnWidth = True 
     .RefreshPeriod = 0 
     .TextFilePromptOnRefresh = False 
     .TextFilePlatform = xlWindows 
     .TextFileStartRow = 1 
     .TextFileParseType = xlFixedWidth 
     .TextFileTextQualifier = xlTextQualifierDoubleQuote 
     .TextFileConsecutiveDelimiter = False 
     .TextFileTabDelimiter = False 
     .TextFileSemicolonDelimiter = False 
     .TextFileCommaDelimiter = False 
     .TextFileSpaceDelimiter = False 
     .TextFileColumnDataTypes = Array(2, 2, 2) 
     .TextFileFixedColumnWidths = Array(14, 18, 12) 
     .TextFileFixedColumnWidths = Array(14, 18, 12) '<-- That’s where I need to be flexible 
     .TextFileTrailingMinusNumbers = True 
     .Refresh BackgroundQuery:=False 

    End With 


End Sub 

---

我下面的代碼有點改裝和它的作品，只是不顯示第四列。 實際上會添加更多的列，所以很高興看到我必須調整代碼以便靈活使用列。任何想法？在此先感謝

文本文件（只顯示2行，將更多的未來）是這樣的：

0000000002666980001F2002 
0000000002666980002G1020709500430120101L05200000000000000000000 

---

編碼：

Sub Button1_Click() 


    Const fPath As String = "H:\MyDocs\xxxxx\TestFiles6.txt" 
    Const fsoForReading = 1 
    Const F1_LEN As Integer = 15 'Reference Number 
    Const F2_LEN As Integer = 4  'Cosectuive Number 
    Const F3_LEN As Integer = 1  'Record Type 
    Const F4_Len As Integer = 4  'Company Number 

    Dim objFSO As Object 
    Dim objTextStream As Object 
    Dim start As Integer 
    Dim fLen As Integer 
    Dim rw As Long 

    Set objFSO = CreateObject("scripting.filesystemobject") 
    Set objTextStream = objFSO.OpenTextFile(fPath, fsoForReading) 
    rw = 2 

    Do Until objTextStream.AtEndOfStream 
     txt = objTextStream.Readline 


     f1 = Trim(Left(txt, F1_LEN)) 
    '------------------------------------------------------------------------------------------------------------ 
     start = F1_LEN + 1 
     f2 = Trim(Mid(txt, start, F2_LEN)) 
    '------------------------------------------------------------------------------------------------------------ 
     start = F1_LEN + F2_LEN + 1 
     f3 = Trim(Mid(txt, start, F3_LEN)) 

     If f3 = "F" Then 
      fLen = 4 
     ElseIf f3 = "G" Then 
      fLen = 50 
     Else 

     End If 

     Debug.Print start 
    '------------------------------------------------------------------------------------------------------------ 
     start = start + 1 
     f4 = Trim(Mid(txt, start, fLen)) 
     Debug.Print f4 
    '------------------------------------------------------------------------------------------------------------ 
     ThisWorkbook.Sheets("data").Cells(rw, 1).Resize(1, 3).Value = Array(f1, f2, f3, f4) 
     rw = rw + 1 
    Loop 

    objTextStream.Close 

末次

Answer 1

未測試：

Sub Tester() 

    Const fPath As String = "C:\SomeFile.txt" 
    Const fsoForReading = 1 
    Const F1_LEN As Integer = 14 
    Const F2_LEN_A As Integer = 8 
    Const F2_LEN_B As Integer = 10 
    Const F3_LEN As Integer = 14 

    Dim objFSO As Object, objTextStream As Object, txt, f1, f2, f3 
    Dim start As Integer, fLen As Integer 
    Dim rw As Long 

    Set objFSO = CreateObject("scripting.filesystemobject") 
    Set objTextStream = objFSO.OpenTextFile(fPath, fsoForReading) 
    rw = 2 

    Do Until objTextStream.AtEndOfStream 
     txt = objTextStream.Readline 


     f1 = Trim(Left(txt, F1_LEN)) 
     start = F1_LEN + 1 

     If f1 = "A" Then 
      fLen = 8 
     ElseIf f1 = "B" Then 
      fLen = 10 
     Else 
      'what if? 
     End If 

     f2 = Trim(Mid(txt, start, fLen)) 
     start = start + fLen + 1 
     f3 = Trim(Mid(txt, start, F3_LEN)) 

     With ThisWorkbook.Sheets("data").Cells(rw, 1).Resize(1, 3) 
      .NumberFormat = "@" 'format cells as text 
      .Value = Array(f1, f2, f3) 
      'alternatively..... 
      '.cells(1).Value = f1 
      '.cells(3).Value = f3 
     End With 
     rw = rw + 1 
    Loop 

    objTextStream.Close 
End Sub