I have a simple questions, after reading from record set and writing ti file in end of loop I need to write in the first line (rowcount) code as below:
sFileName = "C:\filename.csv"
RowCount = 0
Open sFileNameFor Output As #1
Do While Not rst.EOF
'Print #1, rst!Name
Print #1, rst.Fields(0).Value & "|" & rst.Fields(1) ... rst.Fields(n).Value
RowCount = RowCount + 1
rst.MoveNext
Loop
'--header and rowcount
Print #1, "Header Line" & RowCount
I am not finding out how to add header in the first line of file "C:\filename.csv"
Thanks in advance
I found this code which does the job - add it just below the Loop command:
Dim sFileContents As String
Close #1
Open sFileNameFor For Binary As 1
sFileContents = Space$(LOF(1))
Get #1, 1, sFileContents
Put #1, 1, "Header Line " & RowCount & vbCrLf
Put #1, , sFileContents
Close #1
Source:
http://www.pcreview.co.uk/threads/how-write-into-text-file-at-first-and-last-line-with-excel-vba.4046562/
Afaik, there is no collection of every Field.Name in the recordset. Instead, you have to loop over the collection Fields and get each items .Name-property like so:
For i = 1 To rst.Fields.Count
Debug.Print rst.Fields(i - 1).Name
Next i
Generate a string out of that with, let's say, something like this:
Dim strHeader as String
strHeader = rst.Fields(0).Name
For i = 1 To rst.Fields.Count - 1
strHeader = strHeader & "|" & rst.Fields(i).Name
Next i
Counting i is obviously a bit weird, bc, you know, 0-based arrays in VBA.
Hope that helps.
Related
I am trying to copy an Excel range to a .txt file.
The export is successful, with one exception, It adds one "extra" empty line at the end.
I've read and tests many of the solution on SO (and other sites), but still without any success.
My Code (relevant part)
' === Export to the .txt file ===
Dim TxtFileName As String, lineText As String
TxtFileName = ThisWorkbook.Path & "\Inv_" & Format(Date, "yyyymmdd") & ".txt"
Open TxtFileName For Output As #1
With StockSht
For i = 1 To LastRow
For j = 1 To 3
If j = 3 Then
lineText = lineText & .Cells(i, j).Value2
Else ' j = 1 or 2
lineText = lineText & .Cells(i, j).Value2 & vbTab
End If
Next j
Print #1, lineText
lineText = ""
Next i
End With
Close #1
My StockSht (worksheet object) and LastRow are defined correctly, and getting their values.
Screen-shot of the end of the exported .txt file
You can use a semi-colon in the Print statement to control the insertion point (i.e. prevent the line-feed on the last line).
The relevant bit on the MSDN page:
Use a semicolon to position the insertion point immediately after the last character displayed.
I tested this code:
Sub PrintTest()
Dim lng As Long
Open "C:\foo3.txt" For Output As #1
For lng = 1 To 10
If lng < 10 Then
Print #1, "foo" & lng
Else
Print #1, "foo" & lng; '<-- semi-colon prevents the newline
End If
Next lng
Close #1
End Sub
So I would update your code like below (not tested):
' === Export to the .txt file ===
Dim TxtFileName As String, lineText As String
TxtFileName = ThisWorkbook.Path & "\Inv_" & Format(Date, "yyyymmdd") & ".txt"
Open TxtFileName For Output As #1
With StockSht
For i = 1 To LastRow
For j = 1 To 3
If j = 3 Then
lineText = lineText & .Cells(i, j).Value2
Else ' j = 1 or 2
lineText = lineText & .Cells(i, j).Value2 & vbTab
End If
Next j
'--- new bit: check for i against LastRow and add the semicolon on last row
If i <> LastRow Then
Print #1, lineText
Else
Print #1, lineText; '<-- semi colon keeps insertion point at end of line
End If
lineText = ""
Next i
End With
Close #1
Try using a ; on the last print line.
' === Export to the .txt file ===
Dim TxtFileName As String, lineText As String
TxtFileName = ThisWorkbook.Path & "\Inv_" & Format(Date, "yyyymmdd") & ".txt"
Open TxtFileName For Output As #1
With StockSht
For i = 1 To LastRow
For j = 1 To 3
If j = 3 Then
lineText = lineText & .Cells(i, j).Value2
Else ' j = 1 or 2
lineText = lineText & .Cells(i, j).Value2 & vbTab
End If
Next j
If i = LastRow Then
Print #1, lineText;
Else
Print #1, lineText
End if
lineText = ""
Next i
End With
Close #1
I have a csv file, and I need a VBA function that adds quotes to every string value in the file, so that something like
vertical,device_name,value
mobile,Apple iPad,0
mobile,HTC,3
looks like
"vertical","device_name","value"
"mobile","Apple iPad",0
"mobile","HTC",3
What I have found until now is a macro,
Sub QuotesAroundText()
Dim c As Range
For Each c In Selection
If Not IsNumeric(c.Value) Then
c.Value = """" & c.Value & """"
End If
Next c
End Sub
that does almost exactly what I need - it add the quotes, but not to string, but to excel cells. That means, that this macro does work correctly in a xlsx file, but not in a csv file.
So I need a vba code that adds quotes not to cells, but to string, that are between commas.
By emulating a string builder I was able to process a CSV file with 59,507 Rows x 9 Columns in just over 3 seconds. This process is much faster that standard concatenation.
This function was modified from my answer to Turn Excel range into VBA string
Test
Sub TestProcessCSVFile()
Dim s As String
Dim Start: Start = Timer
ProcessCSVFile "C:\Users\Owner\Downloads\SampleCSVFile_53000kb.csv", "C:\Users\Owner\Downloads\_temp.csv"
Debug.Print "Execution Time: "; Timer - Start; "Second(s)"
End Sub
Code
Sub ProcessCSVFile(OldFile As String, NewFile As String)
Dim Data As String, text As String
Dim vCell
Dim length As Long
Open OldFile For Binary As #1
Data = Space$(LOF(1))
Get #1, , Data
Close #1
text = Space(Len(Data) * 1.5)
For Each vCell In Split(Replace(Data, vbCrLf, "," & vbCrLf & ","), ",")
If Len(vCell) + length + 5 > Len(text) Then text = text & Space(Len(Data) * 0.1)
If vCell = vbCrLf Then
Mid(text, length, 1) = vbCrLf
ElseIf IsNumeric(vCell) Then
Mid(text, length + 1, Len(vCell) + 1) = vCell & ","
length = length + Len(vCell) + 1
Else
Mid(text, length + 1, Len(vCell) + 3) = Chr(34) & vCell & Chr(34) & ","
length = length + Len(vCell) + 3
End If
Next
Open NewFile For Output As #1
Print #1, Left(text, length - 1)
Close #1
End Sub
Results
Read the text file in using line input, then taylor the following process to your needs:
Sub y()
a = "a,b,c,d"
'Split into 1d Array
b = Split(a, ",", , vbTextCompare)
'for each element in array add the quotes
For c = 0 To UBound(b)
b(c) = """" & b(c) & """"
Next c
'join the product up
d = Join(b, ",")
'Print her out
Debug.Print d
End Sub
use workbooks.opentext filename:="your csv file with path",
It will open the csv and separate them into cells,
then apply your macro and save again as csv
I am new to vba and am trying to create a simple macro to export some data to a text file. I have that working, however, when a user applies any filters that hide rows, it simply exports all data from the first row to the last row, disregarding anything filtered out. I have searched all over, but (probably from my lack of experience with vba) I cannot find anything that will work with both the user's filter and their selection. The thing is, I don't even know if filtered rows are considered by excel to be "hidden". I've also tried many methods other than what was listed below, such as .AutoFilter and .SpecialCells(xlCellTypeVisible), however neither of them work with Selection.
Sub old_export_for()
Dim myFile As String, rng As Range, cellValue As Variant, i As Integer, j As Integer
myFile = "C:\OUT\old_out_" + CStr(Format(Now(), "mmddhhmm")) + ".txt"
Set rng = Selection
Open myFile For Output As #1
For i = 1 To rng.Rows.Count
If Not rng.Rows.Hidden Then
j = 1
cellValue = rng.Cells(i, j).Value
Print #1, "Filename : " + CStr(cellValue)
j = 2
cellValue = rng.Cells(i, j).Value
Print #1, "File Size : " + CStr(cellValue)
j = 3
cellValue = rng.Cells(i, j).Value
Print #1, "Hostname : " + CStr(cellValue)
j = 4
cellValue = rng.Cells(i, j).Value
Print #1, "Date : " + CStr(cellValue)
j = 5
cellValue = rng.Cells(i, j).Value
Print #1, "Session ID : " + CStr(cellValue),
Print #1, vbNewLine + vbNewLine
End If
Next i
Close #1
End Sub
Change
If Not rng.Rows.Hidden Then
to
If Not rng.Rows(i).EntireRow.Hidden Then
Just to show how I would put this with the SpecialCells:
Sub old_export_for()
Dim myFile As String, rng As Range, cellValue As Variant, xRow As Variant
myFile = "C:\OUT\old_out_" + CStr(Format(Now(), "mmddhhmm")) & ".txt"
Set rng = Selection.SpecialCells(xlCellTypeVisible)
Open myFile For Output As #1
For Each xRow In rng.Rows
Print #1, "Filename : " & CStr(xRow.Cells(1).Value)
Print #1, "File Size : " & CStr(xRow.Cells(2).Value)
Print #1, "Hostname : " & CStr(xRow.Cells(3).Value)
Print #1, "Date : " & CStr(xRow.Cells(4).Value)
Print #1, "Session ID : " & CStr(xRow.Cells(5).Value)
Print #1, vbNewLine & vbNewLine
Next i
Close #1
End Sub
still, for a sub this short, I'd use something non-readable like this:
Sub old_export_for()
Dim xRow As Variant, i As Long, str As String
Open "C:\OUT\old_out_" + CStr(Format(Now(), "mmddhhmm")) & ".txt" For Output As #1
For Each xRow In Selection.SpecialCells(xlCellTypeVisible).Rows: For i = 1 To 6
Print #1, Array("Filename : ", "File Size : ", "Hostname : ", "Date : ", "Session ID : ", vbNewLine)(i - 1) & Array(CStr(xRow.Cells(i).Value), vbNewLine)(1 + (i < 6))
Next: Next
Close #1
End Sub
But do not do this :P
If this is not helpful, I will delete the answer. Say we have AutoFiltered data in Sheet1. This tiny macro will take the header row and all the visible data rows and copy them to Sheet2
Sub AutoFilterCopyVisible()
Sheets("Sheet1").AutoFilter.Range.Copy
Sheets("Sheet2").Paste
End Sub
After running this, you can export Sheet2. If Sheet1 is like:
then Sheet2 will have:
Note:
There is no autofiltering in the output sheet.
I have the following VBA code:
Sub read_in_data_from_txt_file()
Dim dataArray() As String
Dim i As Integer
Const strFileName As String = "Z:\sample_text.txt"
Open strFileName For Input As #1
' -------- read from txt file to dataArrayay -------- '
i = 0
Do Until EOF(1)
ReDim Preserve dataArray(i)
Line Input #1, dataArray(i)
i = i + 1
Loop
Close #1
Debug.Print UBound(dataArray())
End Sub
I'm trying to read in text line by line (assume 'sample.txt' is a regular ascii file) from a file and assign this data to consecutive elements in an array.
When I run this, I get all my data in the first value of the array.
For example, if 'sample.txt' is:
foo
bar
...
dog
cat
I want each one of these words in a consecutive array element.
What you have is fine; if everything ends up in dataArray(0) then the lines in the file are not using a CrLf delimiter so line input is grabbing everything.
Instead;
open strFileName for Input as #1
dataArray = split(input$(LOF(1), #1), vbLf)
close #1
Assuming the delimiter is VbLf (what it would be coming from a *nix system)
Here is a clean code on how to use for each loop in VBA
Function TxtParse(ByVal FileName As String) As String
Dim fs, ts As Object
Dim strdic() As String
Dim oitem As Variant
Set fs = CreateObject("Scripting.FileSystemObject")
Set ts = fs.OpenTextFile(FileName, 1, False, -2)
strdic = Split(ts.ReadAll, vbLf)
For Each oitem In strdic
If InStr(oitem, "YourString") <> 0 Then
Else
If InStr(1, oitem, vbTab) <> 0 Then
Debug.Print "Line number is : "; "'" & Replace(oitem, vbTab, "','") & "'"
Else
Debug.Print "Line number is : "; "'" & Replace(oitem, ",", "','") & "'"
End If
End If
Next
End Function
So, I have a macro to export data into CSV format and it's working great (Code at the bottom). The problem is the data I am putting into it. When I put the data in question in it comes out
Firstname,Lastname,username,password,description
I'd like to change it so I get
Firstname Lastname,Firstname,Lastname,username,password,description
What I'd like to do is manipulate the existing macro so to accomplish this. I'm not so good at VBS so any input or a shove in the right direction would be fantastic.
Thanks!
The code is from user Chance2 http://www.excelforum.com/excel-programming/679620-set-up-macro-to-export-as-csv-file.html. Fair is fair and the author should be rightly attributed. I apologize for making any of this sound proprietary.
Sub Make_CSV()
Dim sFile As String
Dim sPath As String
Dim sLine As String
Dim r As Integer
Dim c As Integer
r = 1 'Starting row of data
sPath = "C:\CSVout\"
sFile = "MyText_" & Format(Now, "YYYYMMDD_HHMMSS") & ".CSV"
Close #1
Open sPath & sFile For Output As #1
Do Until IsEmpty(Range("A" & r))
'You can also Do Until r = 17 (get the first 16 cells)
sLine = ""
c = 1
Do Until IsEmpty(Cells(1, c))
'Number of Columns - You could use a FOR / NEXT loop instead
sLine = sLine & """" & Replace(Cells(r, c), ";", ":") & """" & ","
c = c + 1
Loop
Print #1, Left(sLine, Len(sLine) - 1) 'Remove the trailing comma
r = r + 1
Loop
Close #1
End Sub
Simplest change would be to assign sLine with the 'Firstname Lastname' concatenation i.e.:
Do Until IsEmpty(Range("A" & r))
'You can also Do Until r = 17 (get the first 16 cells)
sLine = """" & Replace(Cells(r,1) & " " & Cells(r,2), ";", ":") + ""","
c = 1
Do Until IsEmpty(Cells(1, c))
'Number of Columns - You could use a FOR / NEXT loop instead
sLine = sLine & """" & Replace(Cells(r, c), ";", ":") & """" & ","
c = c + 1
Loop
Print #1, Left(sLine, Len(sLine) - 1) 'Remove the trailing comma
r = r + 1
Loop