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
Related
I'm importing a table from a Tab-separated text file. I'm only interested in certain columns, so this is what I'm trying to do:
No problem: Read entire file into one long string
No problem: Split long string into rows, along vbCrlf
No problem: split each row into cells, along vbTab. Put those values into a 2d array
Problem: Sheets("Sheet2").Range("A:A") = Matrix (only a selected column)
I need help to find the syntax how to address e.g. the 5th column of the matrix, all rows.
Did I make myself clear?
Open Filename For Binary As #1
MyData = Space$(LOF(1))
Get #1, , MyData
Close #1
strData() = Split(MyData, vbCrLf)
Debug.Print strData(1)
Dim Matrix() As String
Dim Fields() As String
Fields = Split(strData(0), vbTab)
Dim Rader As Long
Dim Kolumner As Long
ReDim Matrix(UBound(strData), UBound(Fields))
For Rader = 0 To UBound(strData)
Fields() = Split(strData(Rader), vbTab)
For Kolumner = 0 To UBound(Fields)
Matrix(Rader, Kolumner) = Fields(Kolumner)
Next Kolumner
Next Rader
Sheets("Sheet2").Range("A:A") = Matrix 'that gets me the first column. How to pick another matrix column?
Write Only Specified Columns From Array to Worksheet
Adjust the constants including the workbook and DataColumns.
The first Sub writes the columns specified in DataColumns to a worksheet.
The second Sub writes all columns to the worksheet.
The rest is being called.
ByRef (not necessary) is used to point out that values
are being modified in the referred variable.
The Code
Option Explicit
Sub writeColumns()
' Text
Const FilePath As String = "G:\Data\Baby Names\yob2018.txt"
Const LineDelimiter As String = vbCrLf
Const FieldDelimiter As String = ","
' Worksheet
Const wsId As Variant = "Sheet1"
Const FirstCell As String = "A1"
Dim wb As Workbook: Set wb = ThisWorkbook
Dim DataColumns() As Variant: DataColumns = Array(3, 1)
' Write from Text File to Data Array.
Dim Data() As String
getTextToArray Data, FilePath, LineDelimiter, FieldDelimiter
' Write from Data Array to Columns Array.
Dim Cols() As Variant: Cols = getColumns(Data, DataColumns)
' Write from Columns Array to Columns Range.
writeWorksheet Cols, wb, wsId, FirstCell
End Sub
Sub writeAll()
' Text
Const FilePath As String = "G:\Data\Baby Names\yob2018.txt"
Const LineDelimiter As String = vbCrLf
Const FieldDelimiter As String = ","
' Worksheet
Const wsId As Variant = "Sheet1"
Const FirstCell As String = "A1"
Dim wb As Workbook: Set wb = ThisWorkbook
' Write from Text File to Data Array.
Dim Data() As String
getTextToArray Data, FilePath, LineDelimiter, FieldDelimiter
' Write from Data Array to Data Range.
writeWorksheet Data, wb, wsId, FirstCell
End Sub
Sub getTextToArray(ByRef Data() As String, _
ByVal FilePath As String, _
Optional ByVal LineDelimiter As String = vbCrLf, _
Optional ByVal FieldDelimiter As String = " ")
' Write from Text File to Text Variable.
Dim Text As String: getText Text, FilePath
' Write from Text Variable to Lines Array.
Dim Lines() As String: getLines Lines, Text, LineDelimiter
' Split Lines Array to Data Array.
getFields Data, Lines, FieldDelimiter
End Sub
Sub getText(ByRef Text As String, _
ByVal TextFilePath As String)
Open TextFilePath For Binary As #1
Text = Space$(LOF(1)): Get #1, , Text
Close #1
End Sub
Sub getLines(ByRef Lines() As String, _
ByVal Text As String, _
Optional ByVal LineDelimiter As String = vbCrLf)
Lines = Split(Text, LineDelimiter)
removeLastEmptyLines Lines
End Sub
Sub removeLastEmptyLines(ByRef Lines() As String)
If UBound(Lines) = -1 Then Exit Sub
Dim c As Long, ub As Long: ub = UBound(Lines)
For c = ub To LBound(Lines) Step -1
If Lines(c) = Empty Then
ub = ub - 1: ReDim Preserve Lines(ub)
Else
Exit For
End If
Next c
End Sub
Sub getFields(ByRef Data() As String, _
Lines() As String, _
Optional ByVal FieldDelimiter As String = " ")
Dim Fields() As String: Fields = Split(Lines(0), FieldDelimiter)
Dim ubL As Long: ubL = UBound(Lines) + 1
Dim ubF As Long: ubF = UBound(Fields) + 1
ReDim Data(1 To ubL, 1 To ubF)
Dim r As Long, c As Long
For r = 1 To ubL
Fields = Split(Lines(r - 1), FieldDelimiter)
For c = 1 To ubF
Data(r, c) = Fields(c - 1)
Next c
Next r
End Sub
Function getColumns(Data() As String, _
DataColumns() As Variant) _
As Variant
Dim ubD As Long: ubD = UBound(Data)
Dim ubC As Long: ubC = UBound(DataColumns)
Dim Result As Variant: ReDim Result(1 To UBound(Data), 1 To ubC + 1)
Dim r As Long, c As Long
For r = 1 To ubD
For c = 0 To ubC
Result(r, c + 1) = Data(r, DataColumns(c))
Next c
Next r
getColumns = Result
End Function
Sub writeWorksheet(Data As Variant, WorkbookObject As Workbook, _
Optional ByVal WorksheetNameOrIndex As Variant = "Sheet1", _
Optional ByVal FirstCellAddress As String = "A1")
With WorkbookObject.Worksheets(WorksheetNameOrIndex).Range(FirstCellAddress)
.Resize(UBound(Data), UBound(Data, 2)).Value = Data
End With
End Sub
I want to open a txt-File, read the textlines into arrays, delete specific arrays and write all those textlines into another textfile.
It might be easier to understand if you read the code:
Sub:
Open "G:\Arbeit\gen molding\Molding.spf" For Input As #1 'code from textfile below
Dim i As Integer
Dim tlmold() As String
Do Until EOF(1) 'read into array
ReDim Preserve tlmold(i)
Line Input #1, tlmold(i)
i = i + 1
Loop
Close #1
DeleteFromArray tlmold, "M17" 'function code below
DeleteFromArray tlmold, "I_R828"
*DeleteFromArray tlmold, "I_R872"*
Dim tllength As Integer
tllength = UBound(tlmold)
For i = tllength To 0 Step -1 'newtext is the text for the new txt-file
newtext = newtext & tlmold(i) & vbCrLf
Next i
newtext = Replace(newtext, "ÿþ", "") 'remove BOM
Set Fileout = fso.CreateTextFile("G:\Arbeit\gen molding\Molding2.spf", True, True) 'create new textfile
Fileout.Write newtext
Fileout.Close
Function:
Function DeleteFromArray(ByRef Arr As Variant, StringToBeDeleted As String)
Dim arrlength As Integer
Dim strtest As String
arrlength = UBound(Arr)
strtest = StringToBeDeleted
For i = 0 To arrlength
strtest = Arr(i)
If InStr(strtest, StringToBeDeleted) <> 0 Then
Arr(i) = ""
ReDim Preserve Arr(arrlength - 1)
Exit Function
End If
Next i
End Function
Textfile "MOLDING.SPF":
G01 Z=0.1
G01 X=24.371 Z=-0.886
G03 X=24.370 Z=-1.040 CR=15.075
G01 X=24.126 Z=-12.934
G02 X=24.121 Z=-13.232 CR=50.500
G01 X=I_R830 *Z=-I_R872* ;MOLDING END PT
G01 *Z=-I_R872*-1.200
G01 X=I_R828
M17
The problem is while deleting I_R872 from the textfile, my function does notReDim the array a second time.
Because I_R872 is two times in the textfile.
So the array tlmold(5), which shouldn't exist, is just empty.
I hope you understand my "code" and can help me with my problem.
Thanks in Advance
The easiest way to accomplish what you are trying to do is simply not to place the unwanted text into the array in the first place:
Open "G:\Arbeit\gen molding\Molding.spf" For Input As #1 'code from textfile below
Dim i As Long
Dim j As Long
Dim tlmold() As String
Dim lineIn as String
Dim wanted As Boolean
Dim unwantedText
unwantedText = Array("M17","I_R828","I_R872")
Do Until EOF(1) 'read into array
'Read an input line
Line Input #1, lineIn
'Now decide whether we want that record
wanted = True
For j = LBound(unwantedText) To UBound(unwantedText)
If InStr(lineIn, unwantedText(j)) > 0 Then
wanted = False
Exit For
End If
Next
'If we want this record, re-dimension the array and store the value
If wanted Then
ReDim Preserve tlmold(i)
tlmold(i) = lineIn
i = i + 1
End If
Loop
Close #1
Dim tllength As Integer
'...
An alternative way to bypass arrays and loops is to work with the entire text of the file
Option Explicit
Public Sub UpdateFile()
Const FPATH = "G:\Arbeit\gen molding\"
Const SRC_FILE = FPATH & "Molding.spf"
Const DST_FILE = FPATH & "Molding2.spf"
Dim fullFile As String
Open SRC_FILE For Binary As #1
fullFile = Space$(LOF(1)) 'Read entire file into variable fullFile
Get #1, , fullFile
Close #1
fullFile = Replace(fullFile, "M17", vbNullString)
fullFile = Replace(fullFile, "I_R828", vbNullString)
fullFile = Replace(fullFile, "ÿþ", vbNullString)
Open DST_FILE For Output As #1
Print #1, fullFile 'Write contents back to the new file
Close #1
End Sub
Using newtext = Join(tlmold,vbCrLf) is much faster than the loop below:
For i = tllength To 0 Step -1 'newtext is the text for the new txt-file
newtext = newtext & tlmold(i) & vbCrLf
Next i
You could also use the Scripting.FileSystemObject to read the file. I refactored your code using a StringBuilder instead of an array. StringBuilders are optimized for concatenating strings.
Sub CreateNewSPF()
Const SPF_FILENAME1 = "G:\Arbeit\gen molding\Molding.spf"
Const SPF_FILENAME2 = "G:\Arbeit\gen molding\Molding2.spf"
Const ForReading = 1
Const ForWriting = 2
Dim lineIn As String
Dim fso As Object, StringBuilder As Object, TextStream1 As Object
Set fso = CreateObject("Scripting.FileSystemObject")
Set StringBuilder = CreateObject("System.Text.StringBuilder")
Set TextStream1 = fso.OpenTextFile(SPF_FILENAME1, ForReading)
Do Until TextStream1.AtEndOfStream
lineIn = TextStream1.ReadLine
If isValidSPF(lineIn) Then StringBuilder.Append_3 lineIn & vbCrLf
Loop
TextStream1.Close
StringBuilder.Replace "ÿþ", ""
Set Fileout = fso.CreateTextFile(SPF_FILENAME2, True, True) 'create new textfile
Fileout.Write StringBuilder.ToString
Fileout.Close
End Sub
Function isValidSPF(lineIn As String) As Boolean
Dim v As Variant
For Each v In Array("M17", "I_R828", "I_R872")
If InStr(1, lineIn, v, vbTextCompare) > 0 Then Exit Function
Next
isValidSPF = True
End Function
I'm very new to Excel VBA and I want to get text from clipboard into a 2D array, with first delimiter vbNewLine and second delimiter space. How do I create a 2D array with unknown size? Can I split an array, like below where I fail?
Sub CommandButton1_Click()
Dim DataObj As MsForms.DataObject
Set DataObj = New MsForms.DataObject
Dim strArray() As String
On Error GoTo ERRROR
'~~> Get data from the clipboard.
DataObj.GetFromClipboard
'~~> Get clipboard contents
myString = DataObj.GetText(1)
'~~> Split into string, delimiter vbNewLine
strArray = Split(myString, vbNewLine)
Here is here I fail
'~~> Split each strArray and store in strArray2, delimiter " ".
Dim strArray2() As String
For ii = LBound(strArray2) To UBound(strArray2)
strArray2(ii) = Split(strArray(ii))
Next ii
Exit Sub
ERRROR:
If Err <> 0 Then
'Handel error
End If
End Sub
You are doing it the wrong way.
Is this what you are trying? (UNTESTED)
Sub CommandButton1_Click()
Dim DataObj As MsForms.DataObject
Dim strArray, strArray2
Dim i As Long, j As Long
Dim myString As String
On Error GoTo ERRROR
Set DataObj = New MsForms.DataObject
'~~> Get data from the clipboard.
DataObj.GetFromClipboard
'~~> Get clipboard contents
myString = DataObj.GetText(1)
'~~> Split myString, delimiter vbNewLine
strArray = Split(myString, vbNewLine)
'~~> Split each strArray and store in strArray2, delimiter " ".
For i = LBound(strArray) To UBound(strArray)
strArray2 = Split(strArray(i))
For j = LBound(strArray2) To UBound(strArray2)
Debug.Print strArray2(j)
Next j
Next i
Exit Sub
ERRROR:
If Err <> 0 Then Debug.Print Err.Description
End Sub
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 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)