I have a .dat file that just holds a list of names, each name is on a new line. How would I go about getting those names out of the file and putting them into a array?
you should read this
http://www.visualbasic.happycodings.com/Files_Directories_Drives/code54.html
Excerpt
Function FileLoadToArray(ByRef asLines() As String, ByVal sFileName As String) As String
Dim iFileNum As Long, lFileLen As Long
Dim sBuffer As String
'Initialise Variables
On Error GoTo ErrFailed
'Open File
iFileNum = FreeFile
Open sFileName For Binary Access Read As #iFileNum
'Get the size of the file
lFileLen = LOF(iFileNum)
If lFileLen Then
'Create output buffer
sBuffer = String(lFileLen, " ")
'Read contents of file
Get iFileNum, 1, sBuffer
'Split the file contents
asLines = Split(sBuffer, vbNewLine)
End If
Close #iFileNum
'Return success
FileLoadToArray = ""
Exit Function
ErrFailed:
Debug.Assert False
Debug.Print Err.Description
FileLoadToArray = Err.Description
'Close file
If iFileNum Then
Close #iFileNum
End If
End Function
My VB6 is a bit rusty but I would think it was something like this, thanks to Google! :P
DIM FileNo AS Integer
DIM strNameList() AS STRING
FileNo = FreeFile
Open "file.dat" For Input As FileNo
Do Until EOF(FileNo)
Line Input FileNo, strNameList(UBound(strNameList))
REDIM Preserve strNameList(UBound(strNameList) + 1)
Loop
Close FileNo
Now strNameList will have the array of entries from the file...Phew...I hope this is correct despite my rustic skills....
You can use a generic read-all-file function
Private Function ReadFile(sFile As String) As String
Dim nFile As Integer
nFile = FreeFile
Open sFile For Input Access Read As #nFile
ReadFile = Input$(LOF(nFile), nFile)
Close #nFile
End Function
with Split function like this
Dim vSplit As Variant
vSplit = Split(ReadFile("your_file.txt"), vbCrLf)
Related
I have a program that reads all info from .txt file and after this showing in MsgBox. Need to know, how to print every second line (every second name) from this file and show in MsgBox. Here is my code:
Sub Printed
Dim sFileText As String
Dim sFinal as String
Dim iFileNo As Integer
iFileNo = FreeFile
Open "D:\Information\data.txt" For Input As #iFileNo
Do While Not EOF(iFileNo)
Input #iFileNo, sFileText
sFinal = sFinal & sFileText & vbCRLF
Loop
MsgBox sFinal
Close #iFileNo
End Sub
Here is, how .txt file looks
Here is how it showing now in MsgBox:
Try this:
Sub Printed
Dim sFileText As String
Dim sFinal as String
Dim iFileNo As Integer
Dim fIgnoreLine As Boolean
iFileNo = FreeFile
' fIgnoreLine = True ' uncomment this line if you want to print every even line
Open "D:\Information\data.txt" For Input As #iFileNo
Do While Not EOF(iFileNo)
Line Input #iFileNo, sFileText
if Not fIgnoreLine then sFinal = sFinal & sFileText & vbCRLF
fIgnoreLine = Not fIgnoreLine
Loop
MsgBox sFinal
Close #iFileNo
End Sub
I want to amend a specific line (example: line #5) of a .txt file using VBA.
How would I be able to do so?
Below is some VBA code that reads in a text file in one chunk, splits it into separate lines into an array, replaces the text on the fifth line (the array is 0-based, so the elements are 0, 1, 2, 3, 4, 5,.....), and then joins it back together to write it out to a text file. It then finally deletes the original file, and renames the output file.
Sub sAlterFile()
Dim strInFile As String
Dim strOutFile As String
Dim intInFile As Integer
Dim intOutFile As Integer
Dim strInput As String
Dim aData() As String
intInFile = FreeFile
strInFile = "C:\test\sample.txt"
Open strInFile For Input As intInFile
strInput = Input(LOF(intInFile), intInFile)
aData() = Split(strInput, vbCrLf)
aData(LBound(aData) + 4) = "new"
intOutFile = FreeFile
strOutFile = "C:\test\amended.txt"
Open strOutFile For Output As intOutFile
Print #intOutFile, Join(aData(), vbCrLf)
Close #intInFile
Close #intOutFile
Kill strInFile
Name strOutFile As strInFile
End Sub
Regards,
I have a .csv which is in the following format:
[TestHeader]FIELDS,"LANGUAGE","LC_NUMERIC","CELLNAME","TESTTYPE","REPORTER","TITLE","STARTDATE","STARTTIME","ENDDATE","ENDTIME"DATATYPE,"Text(80)","Text(80)","Text(64)","Text(80)","Text(80)","Text(80)","Text(12)","Text(20)","Text(12)","Text(20)"
I would like to put this data in a multidimensional array that would mimic as if it was in a sheet. Where the cells are empty it would be empty in the array as well.
I am trying to use the following but it only puts the data in a 1D array which is not suitable for what I need.
Dim Delimiter As String
Dim TextFile As Integer
Dim FilePath As String
Dim FileContent As String
Dim LineArray() As String
Dim DataArray() As String
'Inputs
Delimiter = ","
FilePath = emiFilePath
'Open the text file in a Read State
TextFile = FreeFile
Open FilePath For Input As TextFile
'Store file content inside a variable
FileContent = Input(LOF(TextFile), TextFile)
'Close Text File
Close TextFile
'Separate Out lines of data
LineArray() = Split(FileContent, Delimiter, -1, vbTextCompare)
'Read Data into an Array Variable
'Re-Adjust Array boundaries
ReDim Preserve DataArray(UBound(LineArray))
'
'Load line of data into Array variable
For y = LBound(LineArray) To UBound(LineArray)
DataArray(y) = Replace(LineArray(y), Chr(34), vbNullString)
Next y
With the help of #Ralph and #VincentG
Dim Delimiter As String
Dim TextFile As Integer
Dim FilePath As String
Dim FileContent As String
Dim LineArray() As String
Dim DataArray() As Variant
'Inputs
Delimiter = ","
FilePath = emiFilePath
'Open the text file in a Read State
TextFile = FreeFile
Open FilePath For Input As TextFile
'Store file content inside a variable
FileContent = Input(LOF(TextFile), TextFile)
'Close Text File
Close TextFile
'Separate Out lines of data
LineArray() = Split(FileContent, vbLf, -1, vbTextCompare)
'Read Data into an Array Variable
'Re-Adjust Array boundaries
ReDim Preserve DataArray(UBound(LineArray))
'
'Load line of data into Array, separate by commas and remove unwanted blank strings
For y = LBound(LineArray) To UBound(LineArray)
DataArray(y) = Split(Replace(LineArray(y), Chr(34), vbNullString), Delimiter)
Next y
When you code:
'Separate Out lines of data
LineArray() = Split(FileContent, Delimiter, -1, vbTextCompare)
you are not separating lines but fields separated by delimiter ","
If your cvs use Windows-Style end of line, first split your data on vbCrLf.
Function mySplit(ByVal emiFilePath As String) As Variant()
Dim Delimiter As String
Dim TextFile As Integer
Dim FilePath As String
Dim FileContent As String
Dim LineArray() As String
Dim DataArray() As Variant
'Inputs
Delimiter = ","
FilePath = emiFilePath
'Open the text file in a Read State
TextFile = FreeFile
Open FilePath For Input As TextFile
'Store file content inside a variable
FileContent = Input(LOF(TextFile), TextFile)
'Close Text File
Close TextFile
'Separate Out lines of data
LineArray = Split(FileContent, vbCrLf, -1, vbTextCompare)
ReDim DataArray(LBound(LineArray) To UBound(LineArray))
Dim i As Long
'Separate fields inside the lines
For i = LBound(LineArray) To UBound(LineArray)
DataArray(i) = Split(LineArray(i), Delimiter, -1, vbTextCompare)
Next i
mySplit = DataArray
End Function
I have multiple "datasheet" text files that are used with a program at work and need to harvest values from them and combine it all into a spreadsheet.
The text files are formatted as such:
[File]
DescText = "1756-IF16H 16 Channel Hart Analog Input Module";
CreateDate = 04-07-10;
CreateTime = 10:29;
Revision = 1.1;
HomeURL = "http://www.ab.com/networks/eds/XX/0001000A00A30100.eds";
[Device]
VendCode = 1;
VendName = "Allen-Bradley";
ProdType = 10;
ProdTypeStr = "Multi-Channel Analog I/O with HART";
ProdCode = 163;
MajRev = 1;
MinRev = 1;
ProdName = "1756-IF16H/A";
Catalog = "1756-IF16H/A";
Icon = "io_brown.ico";
The Tags are consistent through all the files and each lines ends with a semicolon [ ; ] so I'm assuming this should be pretty easy. I need to pull "DescText","VendCode","ProdType","MajRev","MinRev",and"ProdName" into separate columns.
There are about 100 individual data files, each with a nonsensical filename, so I'm looking to have the macro just go through and open each one in the folder.
Thanks for the help, here is the solution I came up with for this specific problem
Sub OpenFiles()
Dim MyFolder As String
Dim MyFile As String
MyFolder = "[directory of files]"
MyFile = Dir(MyFolder & "\*.txt")
Dim filename As String
Dim currentrow As Integer: currentrow = 2
Do While Myfile <> "" 'This will go through all files in the directory, "Dir() returns an empty string at the end of the list
'For i = 1 To 500 'this was my debug loop to only go through the first 500 files at first
filename = MyFolder & "\" & MyFile 'concatinates directory and filename
Open filename For Input As #1
Do Until EOF(1) 'reads the file Line by line
Line Input #1, textline
'Text = Text & textline
If textline = "" Then 'error handler, if line was empty, ignore
Else
Dim splitline() As String
splitline() = Split(textline, "=", -1, vbTextCompare)
'because of how my specific text was formatted, this splits the line into 2 strings. The Tag is in the first element, the data in the second
If IsError(splitline(0)) Then
splitline(0) = ""
End If
Select Case Trim(splitline(0)) 'removes whitespace
Case "DescText"
currentrow = currentrow + 1
'files that didn't have a description row, resulted in empty rows in the spreadsheet.
ActiveSheet.Range("A" & currentrow).Cells(1, 1).Value = splitline(1)
Case "Revision"
ActiveSheet.Range("B" & currentrow).Cells(1, 1).Value = splitline(1)
Case "ProdCode"
ActiveSheet.Range("C" & currentrow).Cells(1, 1).Value = splitline(1)
Case "ProdType"
ActiveSheet.Range("D" & currentrow).Cells(1, 1).Value = splitline(1)
'...etc. etc... so on for each "tag"
End Select
End If
Loop
Close #1
MyFile = Dir() 'reads filename of next file in directory
'currentrow = currentrow + 1
'Next i
Loop
End Sub
here how I would solve the complete task:
Private Sub importFiles(ByVal pFolder As String)
' create FSO
Dim oFSO As Object
Set oFSO = CreateObject("Scripting.FileSystemObject")
' create folder
Dim oFolder As Object
Set oFolder = oFSO.getFolder(pFolder)
' go thru the folder
Dim oFile As Object
For Each oFile In oFolder.Files
' check if is a text file
If UCase(Right(oFile.Name, 4)) = ".TXT" Then
Debug.Print "process file: " & oFolder.Path & "\" & oFile.Name
readFile oFolder.Path & "\" & oFile.Name
End If
Next
' clean up
Set oFolder = Nothing
Set oFSO = Nothing
End Sub
Private Sub readFile(ByVal pFile As String)
' get new file handle
Dim hnd As Integer
hnd = FreeFile
' open file
Open pFile For Input As hnd
Dim sContent As String
Dim sLine As String
' read file
Do Until EOF(hnd)
Line Input #hnd, sLine
sContent = sContent & sLine
Loop
' close file
Close hnd
' extract requiered data
Debug.Print getValue(sContent, "ProdName")
Debug.Print getValue(sContent, "DescText")
End Sub
Private Function getValue(ByVal pContent As String, ByVal pValueName As String) As String
Dim sRet As String
sRet = ""
If InStr(pContent, pValueName) Then
pContent = Mid(pContent, InStr(pContent, pValueName) + Len(pValueName) + 2)
sRet = Left(pContent, InStr(pContent, ";") - 1)
sRet = Trim(sRet)
End If
getValue = sRet
End Function
Overall the solution contains 3 different procedures:
importFiles reads the content of a given directory (which has to be handed over as parameter) and if it finds a .txt file it calls readFile() and passes the full path of the file to it
readFile() opens the text file and stores the content in a string variable. After this is done it calles getValue for each value you are interessted in.
getValue analyses the given content and extractes the given value.
Simply adjust the calls of getValue() so that you get all values you are interessted in and store them instead of showing via debug.print and call the first procedure with the right directory like importFiles "C:\Temp"
I'm trying to save and then load a multi-dimensional VBA array to/from disk. According to the MSDN website, the number of dimensions are saved as a descriptor in the file, but I can't figure out how to access/load them. The example below works, but only because I have hard coded the array dimensions. The commented out line works in a dynamic sense, but the array's dimensions are lost in the process.
Here's some sample code:
Sub WriteArray()
Dim file_name As String
Dim file_length As Long
Dim fnum As Integer
Dim values() As Boolean
ReDim values(1 To 5, 1 To 10, 1 To 20)
Dim i As Integer 'Populate the simple array
For i = 1 To 20
values(1, 1, i) = True
Next
' Delete existing file (if any).
file_name = "array.to.file.vba.bin"
On Error Resume Next
Kill file_name
On Error GoTo 0
' Save the file.
fnum = FreeFile
Open file_name For Binary As #fnum
Put #fnum, 1, values
Close fnum
End Sub
Sub ReadArray()
Dim file_name As String
Dim file_length As Long
Dim fnum As Integer
Dim newArray() As Boolean
file_name = "array.to.file.vba.bin" 'txtFile.Text"
fnum = FreeFile
file_length = FileLen(file_name)
'ReDim newArray(1 To file_length) 'This loads the data, but not with the right dimensions.
ReDim newArray(1 To 5, 1 To 10, 1 To 20) 'This works but with dimensions hard coded.
'How to re-dim here using the dimensions saved in the file?
Open file_name For Binary As #fnum
Get #fnum, 1, newArray
Close fnum
End Sub
I need to give credit to the VB Helper website because the example above is based on one they posted here.
To be honest I didn't know this VBA technique which allows to write array into text file. Or maybe I forgot it. :) Therefore I dived into it.
1st. Writing to the file.
I have some problems with Boolean type of your array. It's not working but it's working with Variant type. And I changed open mode from Binary to Random. Moreover, I used Len parameter for Open Statement with value according to this MSDN information.
This is the first sub improved:
Sub WriteArray()
Dim file_name As String
Dim file_length As Long
Dim fnum As Integer
Dim values() As Variant
ReDim values(1 To 5, 1 To 10, 1 To 20)
Dim i As Integer 'Populate the simple array
For i = 1 To 20
values(1, 1, i) = True
Next
' Delete existing file (if any).
file_name = "array.to.file.vba.bin"
On Error Resume Next
Kill file_name
On Error GoTo 0
' Save the file.
fnum = FreeFile
'<<<<<<< this is new >>>>>>>
Dim arrLen As Long
arrLen = (2 + 3 * 8) + (5 * 10 * 20 * 3)
'<<<<<<< this is changed >>>>>>>
Open file_name For Random As #fnum Len = arrLen
Put #fnum, 1, values
Close fnum
End Sub
2nd. Reading from file
Our array will be Variant type dynamic. I changed file open type to Random from Binary and used Len parameter with the max possible value according to this MSDN information.
This is the second sub improved:
Sub ReadArray()
Dim file_name As String
Dim fnum As Integer
Dim newArray() As Variant
file_name = "array.to.file.vba.bin" 'txtFile.Text"
fnum = FreeFile
'<<<<<<< this is new >>>>>>>
Dim lenAAA
lenAAA = 32767 '>>> MAX possible value
'<<<<<<< this is changed >>>>>>>
Open file_name For Random As #fnum Len = lenAAA
Get #fnum, 1, newArray
Close fnum
End Sub
Screen shot of variables value.