I have a text file with 1000 data entries (only integers).There is one entry per line in the text file. I was wondering how to transfer that data into an array in VBA.
Thank you for taking the time to respond.
Also we can do this without looping:
Sub Test()
Dim FSO As Object, MyFile As Object
Dim FileName As String, Arr As Variant
FileName = "C:\Test\Test.txt" ' change this to your text file full name
Set FSO = CreateObject("Scripting.FileSystemObject")
Set MyFile = FSO.OpenTextFile(FileName, 1)
Arr = Split(MyFile.ReadAll, vbNewLine) ' Arr is zero-based array
'For test
'Fill column A from this Array Arr
Range("A1").Resize(UBound(Arr) + 1, 1).Value = Application.Transpose(Arr)
End Sub
Just save the path to your text file into a variable called FilePath and run this code block.
Dim arInt(1 to 1000) as Integer
Dim intCount as Integer
Set objFSO = CreateObject("Scripting.FileSystemObject")
With = objFSO.OpenTextFile(FilePath, ForReading)
intCount = 1
Do While .EOF = False AND intCount < 1001
arInt(intCount) = Val(.readline)
intCount = intCount + 1
Loop
The Val function turns the string into an number value and then vba casts it to an integer for you.
Afterwards, you have 100 int values in an array.
The code will stop once the file is compete or the array has 1000 values in it.
Related
From the below function I not able get the filenames to excel. Result variable is blank. Please help.
Dim Result As Variant
Function GetFileNames(ByVal FolderPath As String) As Variant
Dim i As Integer
Dim MyFile As Object
Dim MyFSO As Object
Dim MyFolder As Object
Dim MyFiles As Object
Set MyFSO = CreateObject("Scripting.FileSystemObject")
Set MyFolder = MyFSO.GetFolder(FolderPath)
Set MyFiles = MyFolder.Files
ReDim Result(1 To MyFiles.Count)
i = 1
For Each MyFile In MyFiles
Result(i) = MyFile.Name
i = i + 1
Next MyFile
GetFileNames = Result
End Function
Sub GetFileNamesToExcel()
For Each MyFile In MyFiles
Result(i) = MyFile.Name
ActiveCell.Cells(i, 1).Value = Result(i)
i = i + 1
Next MyFile
End Sub
Thanks for your help.
Regards,
Balu.
At first reading, I think your function is OK, but you use it badly.
I would use (quickly written - not tested, sorry)
Sub GetFileNamesToExcel()
dim ar
ar = GetFileNames("d:\somefolder")
'for results on a row
range("a1").resize(1,ubound(ar))= ar
'for results in column (more probably what you want)
range("a1").resize(ubound(ar),1) = application.transpose(ar)
End Sub
And you definitely don't need to use Result as a global variable. That's generally a bad practice, unless you have a specific reason to do that.
I tried to get the number of lines of data in several CSV files in VBA.
Here is the code.
Sub Woo_Products()
Dim fso As New FileSystemObject
Dim flds As Folders
Dim fls As Files
Dim strText As String
Dim i As Integer
Dim j As Integer
Dim k As Integer
Dim extfind As String
Dim FilePath As String
Dim sLineOfText As String
On Error Resume Next
Workbooks.Open Filename:="F:\Work\scrape\" & "woocommerce-products.csv", UpdateLinks:=3
Set fls = fso.getfolder("C:\Users\star\Downloads").Files
k = 2
For Each f In fls
strText = f.Name
extfind = Right$(strText, Len(strText) - InStrRev(strText, "."))
If extfind = "csv" Then
FilePath = "C:\Users\star\Downloads\" & strText
Open FilePath For Input As #1
i = 0
Do Until EOF(1)
Line Input #1, sLineOfText
If sLineOfText <> "" Then i = i + 1
Loop
Close #1
End If
Next
Windows("woocommerce-products.csv").Activate
ActiveWorkbook.Save
ActiveWorkbook.Close
End Sub
But I am getting the same count for each file.
Of course, each file has different lines of data.
Hope to help me for this.
If all you need is a line count, I would write a function to return the count.
Function getFileLineCount(FullFileName As String, Optional LineDelimiter As String = vbNewLine) As Long
Dim text As String
Dim fileNo As Integer, n As Long
fileNo = FreeFile
Open FullFileName For Input As #fileNo
Do Until EOF(1)
Line Input #1, text
n = n + 1
Loop
Close #fileNo
getFileLineCount = n
End Function
Another approach using FileSystemObject:
Public Function GetLineCount(ByVal Path As String) As Long
With CreateObject("Scripting.FileSystemObject")
GetLineCount = UBound(Split(.OpenTextFile(Path, 1).ReadAll, vbNewLine)) + 1
End With
End Function
You'll need to add the references (Tools --> References)
Microsoft Scripting Runtime
Microsoft VBScript Regular Expressions 5.5
This will count "Return & NewLine" characters in the file.
Private Function LineCount(ByVal PathFile As String) As Long
Dim sData As String
Dim oFile As New FileSystemObject
sData = oFile.OpenTextFile(PathFile, ForReading).ReadAll
Dim oRegX As New RegExp
oRegX.Pattern = "\r\n"
oRegX.Global = True
LineCount = oRegX.Execute(sData).Count + 1
Set oRegX = Nothing
Set oFile = Nothing
End Function
i = ActiveWorkbook.ActiveSheet.Cells(ActiveWorkbook.ActiveSheet.Rows.Count, 1).End(xlUp).Row
It's working so well.
I am attempting to pull a column of letter codes using InStr from existing text files. I would like to allow this macro to be flexible enough to allow the option to manually input the letter code being searched.
Where I am running into an issue is when common numbers are in the letter code (i.e. C4 and C45). Originally the code was written to search for 2 specific letter codes, and I was hoping to be able to replace those 2 identifiers with a link to 2 cells.
No such luck, as I keep getting responses that are not exact. Please see the code below:
Private Sub CmdLettersGetfile_Click()
Dim objFSO As Object
Dim myDir As String, myList()
Dim objFolder As Object
Dim objFile As Object
Dim i As Integer
Dim sFolder As String
Dim fd As Office.FileDialog
Dim row As Long
Dim row1 As Long
Dim FCount As Integer
Dim FCount1 As Integer
Dim Val As String
Dim Pos As Integer
Dim Last1 As Long 'Mark the last row
Dim Start2 As Long
Dim Last2 As Long 'Mark the last row
Set fd = Application.FileDialog(msoFileDialogFilePicker)
For Each cn In ThisWorkbook.Connections
cn.Delete
Next cn
With ActiveSheet
Lastrow = Sheets("MAIN").Cells(.Rows.Count, "E").End(xlUp).row
End With
'
Worksheets("REPORT").Range("A6:AA1000000").ClearContents
Worksheets("REPORT").Range("A6:AA1000000").ClearFormats
row1 = 6 'Start of REPORT ROW
For row = 12 To Lastrow
sFile = Worksheets("MAIN").Cells(row, "E").Value
Pos = InStr(1, sFile, "org")
If Pos = 0 Then
Val = Worksheets("MAIN").Cells(9, "H")
Else
Val = Worksheets("MAIN").Cells(10, "H")
End If
Pos = 0
Dim strFilename As String
Dim strTextLine As String
Dim iFile As Integer
iFile = FreeFile
strFilename = folderName & "\" & sFile
Open strFilename For Input As #iFile
Last1 = 0
Last2 = 0
Do Until EOF(1)
Line Input #1, strTextLine
FCount = FCount
Pos = InStr(1, strTextLine, Val)
I cleaned up some of the irrelevant code in an attempt to save space and focus on the lines where I am having the issue.
********Update (26-Apr-2018 # 18:12 EST):
When I tried to format the Val to be one uppercase letter and 2 numbers
Dim Val As String: Val = "([A-Z]{1})([0-9]{1})([0-9]{1})"
I get the following:
Resulting data
Column I is the letter code that I need to get narrowed down.
*********Update 2 (27-Apr-2018 # 14:37 EST):
Expanded resulting data
I was able to mass redact what I needed to. I hope this offers more insight into what I'm looking to do.
I´m creating a macro that crawls into subfolders and retrieve the name of some files. I used code from this answer to another question and works fine to get the results into the immediate window, but I want to get them into cells, as a list. What I get is just the result of the first iteration.
What I´m trying to do might be obvious, but I swear I tried and couldn´t find the answer by myself. For the record, I´m just starting to code.
My code here. The important part comes at the end, in Sub ListFiles(fld As Object, Mask As String).
Option Explicit
Sub Retrieve_Info()
Dim strPath As Variant
Dim pasta_destino As Range
Dim fle As String
Dim fso As Object 'FileSystemObject
Dim fldStart As Object 'Folder
Dim fld As Object 'Folder
Dim fl As Object 'File
Dim Mask As String
Set pasta_destino = ThisWorkbook.Worksheets("VINCULATOR").Range("pasta_destino")
strPath = Application.GetOpenFilename _
(Title:="Selecione o arquivo.xlsx", _
FileFilter:="Excel Files *.xlsx* (*.xlsx*),")
If Not strPath = False Then
pasta_destino = strPath
fle = Dir(strPath)
Set fso = CreateObject("scripting.FileSystemObject") ' late binding
'Set fso = New FileSystemObject 'or use early binding (also replace Object types)
Set fldStart = fso.GetFolder(Replace(strPath, fle, ""))
Mask = "*.xlsx"
For Each fld In fldStart.SubFolders
ListFiles fld, Mask
Next
End If
End Sub
Sub ListFiles(fld As Object, Mask As String)
Dim fl As Object 'File
Dim vrow As Integer
Dim vinculadas As Range
Dim n_vinc As Range
Set vinculadas = ThisWorkbook.Worksheets("VINCULATOR").Range("vinculadas")
Set n_vinc = ThisWorkbook.Worksheets("VINCULATOR").Range("n_vinc")
vrow = 0
For Each fl In fld.Files
If fl.Name Like Mask And InStr(fl.Name, "completo") = 0 Then
vrow = vrow + 1
vinculadas.Cells(vrow, 1) = fld.Path & "\" & fl.Name
End If
Next
n_vinc = vrow
End Sub
Please, help!
I have taken a slightly different approach which might be easier for you to follow in addition to executing faster. Please try this.
Sub SpecifyFolder()
' 10 Dec 2017
Dim Fd As FileDialog
Dim PathName As String
Dim Fso As Object
Dim Fold As Object, SubFold As Object
Dim i As Long
Set Fd = Application.FileDialog(msoFileDialogFolderPicker)
With Fd
.ButtonName = "Select"
.InitialView = msoFileDialogViewList
.InitialFileName = "C:\My Documents\" ' set as required
.Show
If .SelectedItems.Count Then
PathName = .SelectedItems(1)
Else
Exit Sub ' user cancelled
End If
End With
Set Fd = Nothing
Set Fso = CreateObject("Scripting.FileSystemObject")
Set Fold = Fso.GetFolder(PathName)
ListFiles Fold, "*.xlsx"
For Each SubFold In Fold.SubFolders
ListFiles SubFold, "*.xlsx"
Next SubFold
Set Fso = Nothing
End Sub
Sub ListFiles(Fold As Object, _
Mask As String)
' 10 Dec 2017
Dim Fun() As String ' file list
Dim Rng As Range
Dim Fn As String ' file name
Dim i As Long ' array index
ReDim Fun(1 To 1000) ' maximum number of expected files in one folder
Fn = Dir(Fold.Path & "\")
Do While Len(Fn)
If Fn Like Mask And InStr(Fn, "completo") = 0 Then
i = i + 1
Fun(i) = Fold.Path & "\" & Fn
End If
Fn = Dir
Loop
If i Then
ReDim Preserve Fun(1 To i)
With ThisWorkbook.Worksheets("VINCULATOR")
' specify the column in which to write (here "C")
i = .Cells(.Rows.Count, "C").End(xlUp).Row
Set Rng = .Cells(i + 1, "C").Resize(UBound(Fun), 1)
Application.ScreenUpdating = False
Rng.Value = Application.Transpose(Fun)
Application.ScreenUpdating = True
End With
End If
End Sub
As you see, I have dispensed with specifying a target range, just the sheet and the column (I chose column C; please change as required in the ListFiles sub). Note that the code appends new lists to the existing content of the indicated column.
There are two things the code doesn't do to my entire satisfaction. One, it doesn't write to the first row of an empty column C. Instead, it leaves the first row blank. You might actually like that. Two, It doesn't do sub-subfolders. File names are extracted only from the selected folder and its immediate subfolders. Additional programming would be required for either additional feature, if required.
Finally, I admit that I didn't test for correct transfer of the lists to the worksheet. I think it works correctly but you should check that the first and last names are listed in your worksheet column. They are extracted from the folder but perhaps their omission when writing to the sheet would be a typical error to occur in this particular method.
I have one folder with TXT files (one column). I need to import them in one Worksheet but each file should be in new column. Would be great to add a file name as a header.
I'm trying to increase cl element before new file is open. Is is good direction?
Set cl = ActiveSheet.Cells(1, i)
i = i + 1
How to modify below code? Any help would be greatly appreciated!
Sub ReadFilesIntoActiveSheet()
Dim fso As FileSystemObject
Dim folder As folder
Dim file As file
Dim FileText As TextStream
Dim TextLine As String
Dim Items() As String
Dim i As Long
Dim cl As Range
' Get a FileSystem object
Set fso = New FileSystemObject
' get the directory you want
Set folder = fso.GetFolder("d:\Projects\Data\")
' set the starting point to write the data to
Set cl = ActiveSheet.Cells(1, 1)
' Loop thru all files in the folder
For Each file In folder.Files
' Open the file
Set FileText = file.OpenAsTextStream(ForReading)
' Read the file one line at a time
Do While Not FileText.AtEndOfStream
TextLine = FileText.ReadLine
' Parse the line into | delimited pieces
Items = Split(TextLine, "|")
' Put data on one row in active sheet
For i = 0 To UBound(Items)
cl.Offset(0, i).Value = Items(i)
Next
' Move to next row
Set cl = cl.Offset(1, 0)
Loop
' Clean up
FileText.Close
Next file
Set FileText = Nothing
Set file = Nothing
Set folder = Nothing
Set fso = Nothing
End Sub
Something like this:
Sub ReadFilesIntoActiveSheet()
Dim fso As FileSystemObject
Dim folder As folder
Dim file As file
Dim FileText As TextStream
Dim i As Long
Dim cl As Range
Set fso = New FileSystemObject
Set folder = fso.GetFolder("d:\Projects\Data\")
Set cl = ActiveSheet.Cells(1, 1)
Application.ScreenUpdating = False
For Each file In folder.Files
Set FileText = file.OpenAsTextStream(ForReading)
cl.Value = file.Name
i = 1
Do While Not FileText.AtEndOfStream
cl.Offset(i, 0).Value = FileText.ReadLine
i = i + 1
Loop
FileText.Close
Set cl = cl.Offset(0, 1)
Next file
Application.ScreenUpdating = True
Set FileText = Nothing
Set file = Nothing
Set folder = Nothing
Set fso = Nothing
End Sub
I'll assume that your text file data all fits neatly in one column. If you're iterating over rows and columns like that, I always preferred to use the Cells(x, y).Value syntax.
No guarantee that it's the most efficient way to do things, but this seems like a simple enough procedure that performance won't matter too much.
You could adapt your code to do something like this:
Dim RowIndex As Long 'Excel Rows need the Long data type
Dim ColumnIndex As Integer ' Not as many columns, so use Integer
' Start at column 1.
ColumnIndex = 1
' Do the rest of your file I/O and split into the Items array.
' Here's your column header:
Cells(1, ColumnIndex).Value = file.Name
' Start the actual data in row 2.
RowIndex = 2
For (i = 0 to UBound(Items))
Cells(RowIndex, ColumnIndex).Value = Items(i)
RowIndex = RowIndex + 1
Next i
' When you're all done, advance ColumnIndex so the next time through
' the loop you're outputting on the next Column.
ColumnIndex = ColumnIndex + 1
This should be functionally identical to the Offset syntax you're using, but I've found that using Cells makes it more obvious what index (row or column or both) you're iterating over.