使用VBA打開多個文本文件

Question

大家好，我的VBA代碼存在一個小錯誤。 我想打開多個文本文件並將其解析為我的Excel。 我可以選擇多個文件，但是只能解析一個文件。我不確定為什么有人可以幫助我。

Sub lithium()
Dim MyData As String, strData() As String
Dim PathInit As String
Dim i As Integer
Dim n As Long
 Dim z As Long, filecount As Long
' Opening the txt file

  Dim myTxt
  myTxt = Application.GetOpenFilename("Text Files,*.txt", , , , True)

On Error Resume Next
filecount = UBound(myTxt)
On Error GoTo 0

If filecount = 0 Then MsgBox "No text file selected. Exiting now.", _
vbExclamation: Exit Sub

 For n = LBound(myTxt) To filecount
Open myTxt(n) For Binary As #1
MyData = Space$(LOF(1))
Get #1, , MyData
Close #1
strData() = Split(MyData, vbCrLf)

'Saving the entire value of the text file into the array. every element in the array in the entire row of the txt file

    '~~> Do stuffs here for text parsing...



 Dim strRow1() As String
 Dim strRow2() As String
 Dim strRow3() As String
 Dim strRow4() As String
 Dim strRow5() As String
 Dim strRow6() As String
 Dim nCount As Integer
' Dim row_number As Integer
 'row_number = 1
 nCount = 1
 Dim nRowLenth As Integer
 nRowLenth = UBound(strData) - LBound(strData) ' Length of the total data array
 j = 3

For i = 5 To nRowLenth


    If nCount Mod 2 <> 0 Then

        strRow1() = Split(strData(i), ";")
        strRow2() = Split(strData(i + 1), ";")
        strRow3() = Split(strData(i + 2), ";")
        strRow4() = Split(strData(i + 3), ";")
        strRow5() = Split(strData(i + 4), ";")
        strRow6() = Split(strData(i + 5), ";")




          Cells(j, 1).Value = strRow1(0)
          Cells(j, 2).Value = Mid(strRow1(2), 3, Len(strRow1(2)))
          Cells(j, 3).Value = CLng("&H" & Mid(strRow2(2), 3, Len(strRow2(2))))
          Cells(j, 4).Value = CLng("&H" & Mid(strRow3(2), 3, Len(strRow3(2))))
          Cells(j, 5).Value = CLng("&H" & Mid(strRow4(2), 3, Len(strRow4(2))))
          Cells(j, 6).Value = CLng("&H" & Mid(strRow5(2), 3, Len(strRow5(2))))
          Cells(j, 7).Value = Mid(strRow6(2), 3, Len(strRow6(2)))

        If i + 5 = nRowLenth Then
            Exit For
        Else
            i = i + 5

        End If
    End If

    If nCount Mod 2 = 0 Then

        strRow1() = Split(strData(i), ";")
        strRow2() = Split(strData(i + 1), ";")
        strRow3() = Split(strData(i + 2), ";")
        Cells(j, 1).Value = strRow1(0)
        Cells(j, 2).Value = "#N/A"
        Cells(j, 3).Value = CLng("&H" & Mid(strRow1(2), 3, Len(strRow1(2))))
        Cells(j, 4).Value = CLng("&H" & Mid(strRow2(2), 3, Len(strRow2(2))))
        Cells(j, 5).Value = CLng("&H" & Mid(strRow3(2), 3, Len(strRow3(2))))
        Cells(j, 6).Value = "#N/A"
        Cells(j, 7).Value = "#N/A"

        If i + 2 = nRowLenth Then
            Exit For
        Else
            i = i + 2

        End If
    End If

 j = j + 1
  nCount = nCount + 1
Next i

'time transformation

Dim l As Long
Dim LR As Long
k = 3
LR = Range("A" & Rows.Count).End(xlUp).Row

 For l = 3 To LR

 Range("H" & k).Value = Val(Left(Right(Range("A" & l).Value, 10), 2)) + Val(Right(Left(Right(Range("A" & l).Value, 10), 5), 2)) / 60 + Val(Right(Right(Range("A" & l).Value, 10), 4)) / 3600

  k = k + 1

 Next l
 Next
  End Sub

Answer 1

嘗試這個：

從代碼中刪除以下行

j = 3

將此行添加到頂部（聲明）

Dim j As Integer
j = 3