I'm trying to read a CSV with VBA. When following this tutorial, I get the following code:
Sub OpenTextFile()
Dim FilePath As String
FilePath = "C:\path\to\file\mycsv.csv"
Open FilePath For Input As #1
row_number = 0
Do Until EOF(1)
Line Input #1, LineFromFile
LineItems = Split(LineFromLine, ",")
ActiveCell.Offset(row_number, 0).Value = LineItems(2)
ActiveCell.Offset(row_number, 1).Value = LineItems(1)
ActiveCell.Offset(row_number, 2).Value = LineItems(0)
row_number = row_number + 1
Loop
Close #1
End Sub
This is my CSV:
peter,paris,23
mary,london,34
steve,rome,56
lily,madrid,65
When executing the code, I get an error:
Index out of range
And this line is marked yellow:
ActiveCell.Offset(row_number, 0).Value = LineItems(2)
You have a typo:
LineItems = Split(LineFromLine, ",")
should be
LineItems = Split(LineFromFile, ",")
This would not have happened if you used Option Explicit at the beginning of your module ;)
Related
I need to run this script outside excel, via powershell/command line.
But I don't know why in excel works propertly as a macro and outside as .vbs via command line a lot of errors happens.
How can I convert it or use this script via command line?
Thanks
Sub csvToXLS(SourcePath, SheetOutput)
Sheets.Add.Name = SheetOutput
Sheets(SheetOutput).Select
' Open SourcePath For Input As #1
Open "C:\temp\Estrattore\2022_07_01-Report123.csv" For Input As #1
row_number = 0
Do Until EOF(1)
Line Input #1, LineFromFile
LineItems = Split(LineFromFile, ";")
ActiveCell.Offset(row_number, 0).Value = LineItems(0) ' Il nostro CSV prevede 7 campi (da 0 a 6)
ActiveCell.Offset(row_number, 1).Value = LineItems(1)
ActiveCell.Offset(row_number, 2).Value = LineItems(2)
ActiveCell.Offset(row_number, 3).Value = LineItems(3)
ActiveCell.Offset(row_number, 4).Value = LineItems(4)
ActiveCell.Offset(row_number, 5).Value = LineItems(5)
ActiveCell.Offset(row_number, 6).Value = LineItems(6)
row_number = row_number + 1
Loop
Close #1
Sheets(SheetOutput).Rows(1).AutoFilter ' Imposto il filtro automatico
Sheets(SheetOutput).Rows(1).Interior.ColorIndex = 31 ' Coloro la prima riga
Worksheets(SheetOutput).Columns("A:I").AutoFit ' Imposto l'autofit, ovvero la colonna ha dimensione tale da mostrare ogni risultato
ActiveWindow.FreezePanes = False ' first, ensure that no panes are frozen
Rows("2:2").Select ' select the row that you want to freeze based on
ActiveWindow.FreezePanes = True ' freeze panes
End Sub
Sub main()
Call csvToXLS("C:\temp\Estrattore\2022_07_01-Report1.csv", "Report1")
Call csvToXLS("C:\temp\Estrattore\2022_07_01-Report2.csv", "Report2")
Call csvToXLS("C:\temp\Estrattore\2022_07_01-Report3.csv", "Report3")
Call csvToXLS("C:\temp\Estrattore\2022_07_01-Report123.csv", "Report123")
End Sub
I would like to print a range of date into .txt file with some special header so that a special software called Prophet could recognize.
Sub Export_TEST()
Dim myFile As String, rng As Range, cellValue As Variant, i As Integer, j As Integer
Dim prophetheader As String
Dim prophetlineheader As String
myFile = Application.DefaultFilePath & "\" & "test" & ".txt"
Set rng = Selection
prophetheader = "!1"
Open myFile For Output As #1
Print #1, rng.Columns.Count - 1
For i = 1 To rng.Rows.Count
For j = 1 To rng.Columns.Count
cellValue = rng.Cells(i, j).Value
If j = rng.Columns.Count Then
Print #1, cellValue
ElseIf i = 1 And j = 1 Then
Print #1, prophetheader, cellValue,
ElseIf j = 1 Then
Print #1, "*", cellValue,
Else
Print #1, cellValue,
End If
Next j
Next i
Close #1
End Sub
The code is quite straight forward, just add * in the front of each line and add !1 in the column header. But I encounter the issue that the output file has been delimited using comma and no double quotation in the string. And I am in the dilemma that if I use write function, it will use comma as delimiter, but has double quotation on string and if I use Print, space as delimiter and no double quote on string.
Is there a way to print the file using comma delimiter and no double quote on string?
Below is the dummy data selection.
SPCODE NAME
1 JS
And the output should be
21
!1,SPCODE,NAME
*,1,JS
Maybe instead of writing each single row to the text file you just write each line in total like that
Option Explicit
Sub Export_TEST()
Dim myFile As String, rng As Range, cellValue As Variant, i As Integer, j As Integer
Dim prophetheader As String
Dim prophetlineheader As String
myFile = ThisWorkbook.Path & "\" & "test" & ".txt"
Set rng = Selection
prophetheader = "!1"
Open myFile For Output As #1
Print #1, rng.Columns.Count - 1
Dim line As String
For i = 1 To rng.Rows.Count
line = ""
For j = 1 To rng.Columns.Count
cellValue = rng.Cells(i, j).Value
If j = rng.Columns.Count Then
line = line & cellValue & ","
ElseIf i = 1 And j = 1 Then
line = line & prophetheader & cellValue & ","
ElseIf j = 1 Then
line = line & "*" & cellValue & ","
Else
line = line & cellValue & ","
End If
Next j
line = Left(line, Len(line) - 1)
Print #1, line
Next i
Close #1
End Sub
I am new to VBA so getting my task done is quite a struggle. Been reading and trying codes from different threads for a few days now to no success. So I am hoping someone could assist me.
I have multiple text files that I need to extract data from. But I only need certain data such as DATE-TIME to be placed in the 1st column and CARD NUMBER in the 2nd column. Got codes from this thread >> Extract a single line of data from numerous text files and import into Excel but my output only shows the first data from the file. Please see the attached files below.
sample text
Output
Desired Output
Here's what I have:
Sub ExtractData()
Dim filename As String, nextrow As Long, MyFolder As String
Dim MyFile As String, text As String, textline As String, filedate As String
Dim filenum As Integer
MyFolder = "C:\directory\"
MyFile = Dir(MyFolder & "*.txt")
Do While MyFile <> ""
Open (MyFolder & MyFile) For Input As #1
Do Until EOF(1)
Line Input #1, textline
text = text & textline
Loop
Close #1
MyFile = Dir()
Debug.Print text
filedate = InStr(text, "DATE-TIME")
nextrow = ActiveSheet.Cells(Rows.Count, "A").End(xlUp).Row + 1
ActiveSheet.Cells(nextrow, "A").value = Mid(text, filedate + 16, 17)
filenum = InStr(text, "CARD NUMBER")
nextrow = ActiveSheet.Cells(Rows.Count, "B").End(xlUp).Row + 1
ActiveSheet.Cells(nextrow, "B").value = Mid(text, filenum + 16, 10)
text = ""
Loop
End Sub
I modify the code for you, it can work:
Sub ExtractData()
Dim filename As String, nextrow As Long, MyFolder As String
Dim MyFile As String, text As String, textline As String, filedate As String
Dim filenum As Integer
dim idx%
MyFolder = "C:\directory\"
MyFile = Dir(MyFolder & "*.txt")
nextrow = ActiveSheet.Cells(Rows.Count, "A").End(xlUp).Row + 1
Do While MyFile <> ""
Open (MyFolder & MyFile) For Input As #1
'nextrow = ActiveSheet.Cells(Rows.Count, "A").End(xlUp).Row + 1
Do Until EOF(1)
Line Input #1, textline 'read a line
idx = InStr(textline, "DATE-TIME") ' if has date, set it but not move to the next ROW
if idx > 0 then
ActiveSheet.Cells(nextrow, "A").value = Mid(textline, idx + 16)
end if
idx = InStr(textline, "CARD NUMBER")
if idx > 0 then
ActiveSheet.Cells(nextrow, "B").value = Mid(textline, filenum + 16)
nextrow = nextrow + 1 'now move to next row
end if
Loop
Close #1
MyFile = Dir()
Loop
End Sub
Thankyou for the time to click on this question. Ive been having problems with placing this data set on my vba code. I always keep on getting a file 'overflow' then a 'file already opened' error. The data set I am using is a data recordings of power consumption over time. And this set of data is meant to be put into 7 arrays. These are the datasets.
https://data.world/databeats/household-power-consumption
What is wrong with my code? Any suggestions?
Thankyou.
My code so far
Dim ID(50) As String, Day(50) As Date
Dim Time(50) As Integer, GlobelActivePower(50) As Integer
Dim Sub1(50) As Integer, Sub2(50) As Integer, Sub3(50) As Integer
Public N As Integer
Sub ReadFileSmall()
Dim Infile As String
Infile = ThisWorkbook.Path & "\Power_smallDataset.csv"
Open Infile For Input As #1
N = 0
Do Until EOF(1)
Input #1, ID(N), Day(N), Time(N), GlobelActivePower(N), Sub1(N),
Sub2(N), Sub3(N)
N = N + 1
Loop
Range("A4").Select
For indx = 0 To N - 1
ActiveCell.Offset(indx, 0).Value = ID(indx)
ActiveCell.Offset(indx, 1).Value = Day(indx)
ActiveCell.Offset(indx, 2).Value = Time(indx)
ActiveCell.Offset(indx, 4).Value = GlobelActivePower(indx)
ActiveCell.Offset(indx, 5).Value = Sub1(indx)
ActiveCell.Offset(indx, 6).Value = Sub2(indx)
ActiveCell.Offset(indx, 7).Value = Sub3(indx)
Next
Close #1
End Sub
The array size is strange.
The following is the data of the csv file.
Sub ReadFileSmall()
Dim Infile As String
Dim vDB
Infile = ThisWorkbook.Path & "\Power_smallDataset.csv"
Workbooks.Open Filename:=Infile, Format:=2
With ActiveSheet
vDB = .UsedRange
End With
ActiveWorkbook.Close (0)
Range("A4").Resize(UBound(vDB, 1), ubouns(vDB, 2)) = vDB
End Sub
I need help with VBA. I would like to read in ONLY 5 lines of data at a time, process the data, ClearContents and repeat until the end of the file.
This is what I have written but it is not working:
Dim FilePath As String, Dim Start As Integer
FilePath = "C:\Users\Main\temp3.txt"
Open FilePath For Input As 3
row_number = 5
Do Until EOF(3)
For Start = 1 To 5
Line Input #36, LineFromFile
LineItems = Split(LineFromFile, ",")
Range("A2").Value = LineItems(0)
Range("B2").Value = LineItems(1)
Range("C2").Value = LineItems(2)
Range("D2").Value = LineItems(3)
Range("E2").Value = LineItems(4)
Range("F2").Value = LineItems(5)
Range("G2").Value = LineItems(6)
row_number = row_number + 1
Next Start
'Process data here
Range("ClearContents").ClearContents
Loop
Close #3
Something like this should work (untested)
Sub Tester()
Const BLOCK_SIZE = 5
Const START_ROW As Long = 2
Dim FilePath As String
Dim LineFromFile As String, arr
Dim rowNum As Long, lineNum As Long
FilePath = "C:\Users\Main\temp3.txt"
Open FilePath For Input As #1
rowNum = START_ROW
lineNum = 0
Do Until EOF(1)
Line Input #1, LineFromFile
lineNum = lineNum + 1
arr = Split(LineFromFile, ",")
ActiveSheet.Cells(rowNum, 1).Resize(1, 7).Value = arr
If lineNum = BLOCK_SIZE Then
'Process data here
Range("ClearContents").ClearContents
rowNum = START_ROW
lineNum = 0
Else
rowNum = rowNum + 1
End If
Loop
Close #3
End Sub
Try to use Thisworkbook.sheets("<nameofsheet>").Range("A2").value or Thisworkbook.sheets(<indexofsheet>).Range("A2").value instead of Range("A2").value.