Это базовый код (общий для @FaneDuru). Этот код работает отлично. Он считывает данные из файла .txt и импортирует первые 160 столбцов в таблицу Excel. Этот код может быть повторно использован в нескольких файлах (выполняется импорт и добавление данных). Например, при первом запуске этого кода он импортирует все данные из первого выбранного файла .txt в мою электронную таблицу. Затем, если я изменю путь к файлу и запусту его снова, он проигнорирует строку заголовка второго файла (точнее, все файлы, кроме первого выбранного файла), и ПРИЛОЖИТ все данные из второго выбранного файла .txt. к существующему листу Excel.
Private Sub CopyLessColumns() 'it copies less columns than the txt file has
Dim strSpec As String, i As Long, colToRet As Long, lastR As Long
Dim arrSp As Variant, arrRez() As String, arrInt As Variant, j As Long, k As Long
Dim fso As Object, txtStr As Object, strText As String 'no need of any reference
Set fso = CreateObject("Scripting.FileSystemObject")
strSpec = " C:\Users\xxxxxx\Desktop\Forecast1.txt"
If Dir(strSpec) <> "" Then 'check if file exists
Set txtStr = fso.OpenTextFile(strSpec)
strText = txtStr.ReadAll
txtStr.Close
End If
arrSp = Split(strText, vbCrLf)
colToRet = 160 'Number of columns to be returned
lastR = ActiveSheet.Range("A" & Rows.count).End(xlUp).Row 'last row in A:A
'arrRez is dimensioned from 0 to UBound(arrSp) only for lastR = 1
ReDim arrRez(IIf(lastR = 1, 0, 1) To UBound(arrSp), colToRet - 1)
For i = IIf(lastR = 1, 0, 1) To UBound(arrSp) 'Only in case of larR = 1, the
'head of the table is load in arr
arrInt = Split(arrSp(i), vbTab) 'each strText line is split in an array
If UBound(arrInt) > colToRet - 1 Then
For j = 0 To colToRet - 1
arrRez(i, j) = arrInt(j) 'each array element is loaded in the arrRez
Next j
End If
Next i
'The array is dropped in the dedicated range (calculated using Resize):
ActiveSheet.Range("A" & IIf(lastR = 1, lastR, lastR + 1)).Resize(UBound(arrRez, 1), _
UBound(arrRez, 2) + 1).Value = arrRez
End Sub
Я пытаюсь сохранить все файлы .txt в папке, а затем использовать функцию vba l oop, чтобы l oop через все файлы .txt и выполнить код выше на них сразу. Поэтому мне не нужно вводить go и изменять путь к файлу каждый раз, когда я хочу запустить этот код в другом файле .txt. Это то, что у меня есть:
Sub readFiles()
Dim file As String, fileCount As Integer
Dim filePath As String
filePath = "C:\Users\xxxxxx\Desktop\Forecast"
file = Dir$(filePath)
fileCount = 0
While (Len(file) > 0)
fileCount = fileCount + 1
ReadTextFile filePath & file, fileCount
file = Dir
Wend
End Sub
Sub ReadTextFile(filePath As String, n As Integer)
Dim strSpec As String, i As Long, colToRet As Long, lastR As Long
Dim arrSp As Variant, arrRez() As String, arrInt As Variant, j As Long, k As Long
Dim fso As FileSystemObject, txtStr As Object, strText As String
Set fso = New FileSystemObject
Set txtStr = fso.OpenTextFile(filePath, ForReading, False)
Do While Not txtStr.AtEndOfStream
arrSp = Split(strText, vbCrLf)
colToRet = 160
lastR = ActiveSheet.Range("A" & Rows.Count).End(xlUp).Row
ReDim arrRez(IIf(lastR = 1, 0, 1) To UBound(arrSp), colToRet - 1)
For i = IIf(lastR = 1, 0, 1) To UBound(arrSp)
arrInt = Split(arrSp(i), vbTab)
If UBound(arrInt) > colToRet - 1 Then
For j = 0 To colToRet - 1
arrRez(i, j) = arrInt(j)
Next j
End If
Next i
ActiveSheet.Range("A" & IIf(lastR = 1, lastR, lastR + 1)).Resize(UBound(arrRez, 1), _
UBound(arrRez, 2) + 1).Value = arrRez
Loop
txtStr.Close
End Sub
По сути, я пытаюсь использовать первую подпрограмму для l oop во всех файлах .txt в папке, затем вызываю первую подпрограмму с указанием пути: параметр функции. Но это не работает как-то. Я не думаю, что с первым подпрограммой (readFiles) что-то не так…
Во втором подпункте, как вы можете видеть в приведенном выше коде, я заменил эту часть базового кода
Set fso = CreateObject("Scripting.FileSystemObject")
strSpec = "C:\Teste VBA Excel\TextFileTabDel.txt"
If Dir(strSpec) <> "" Then 'check if file exists
Set txtStr = fso.OpenTextFile(strSpec)
strText = txtStr.ReadAll
txtStr.Close
End If
с этим:
Set fso = New FileSystemObject
Set txtStr = fso.OpenTextFile(filePath, ForReading, False)
И я поместил оставшуюся часть базового кода в do, пока l oop.
Если я запускаю коды VBA, я НЕ получу никаких предупреждений или знаков ошибок, но появится это окно с сообщением. Но если я нажму Run, ничего не произойдет.
Я действительно понятия не имею, почему это не работает, поэтому любые комментарии / подсказки был бы оценен!