I'm trying to create a new .tsv file by running below code. But the output is still in .csv file eventhough i have set it to .tsv. Is there any way to solve this?
Sub toTxt()
Dim myFile As String, rng As Range, cellValue As Variant, i As Integer, j As Integer
myFile = Application.DefaultFilePath & "\PO" & Format(Now(), "yyyymmddhhmmss") & ".tsv"
iLast = ThisWorkbook.Sheets("PO_Master").Range("C" & Rows.Count).End(xlUp).Row
Set rng = ThisWorkbook.Sheets("PO_Master").Range("A7:BA" & iLast)
Open myFile For Output As #2
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
Write #2, cellValue
Else
Write #2, cellValue,
End If
Next j
Next i
Close #2
Sample output
ASA,"AA","BB","CC","DD","EE","FF"
Try building up a string outputline (you'll need to declare that) and only write the data each row.
For i = 1 To rng.Rows.Count
outputline = ""
For j = 1 To rng.Columns.Count
cellValue = rng.Cells(i, j).Value
If outputline = "" Then
outputline = outputline & cellValue
Else
outputline = outputline & Chr(9) & cellValue
End If
Next j
Print #2, outputline
Next i
Related
VBA code: help me with, I want to save the fillter data to txt file.
Sub Intemp()
Dim arr, i As Long
Dim FPath As String
FPath = ThisWorkbook.Path & "\" & "text" & ".txt"
Application.CutCopyMode = False
arr = Sheet5.Range("B1:C" & [B100000].End(xlUp).Row)
Open FPath For Output As #1
For i = 1 To UBound(arr)
Print #1, arr(i, 1) & vbTab & arr(i, 2)
Next i
Close #1
End Sub
If you want to assign your filtered values to an array, an easy way to do that would be to use advanced filtering and filter into another area of the worksheet and assign your values there.
But a simple approach that will get you started is to just loop your rows in your range, if the row is hidden, then move on - otherwise, print the data to your text document.
Dim rng As Range, r As Long
Set rng = Sheet5.Range("B1:C" & [B100000].End(xlUp).Row)
Dim FPath As String
FPath = ThisWorkbook.Path & "\" & "text" & ".txt"
Application.CutCopyMode = False
Open FPath For Output As #1
With Sheet5
For r = rng.Row To rng.Rows.Count + rng.Row - 1
If Not .Rows(r).Hidden Then
Print #1, .Cells(r, 1) & vbTab & .Cells(r, 2)
End If
Next
End With
Close #1
i need help plz
I have a excel file and I want to export all data from it to a text file.
This the source code:
Sub ExceltoText()
Dim FileName, sLine, Deliminator, x, y, z As String
Dim LastCol, LastRow, FileNumber As Integer
FileName = "C:\Users\Administrateur\Desktop\App vba\ExcToTxt.txt"
Deliminator = "|"
x = "$|0|Les Données de SALARIES"
y = "=|0|Les Données de SALARIES"
z = "=|1|SALARIES|"
LastCol = ActiveSheet.Cells.SpecialCells(xlCellTypeLastCell).Column
LastRow = ActiveSheet.Cells.SpecialCells(xlCellTypeLastCell).Row
FileNumber = FreeFile
Open FileName For Output As FileNumber
For i = 1 To LastRow
For j = 1 To LastCol
If j = LastCol Then
sLine = z & sLine & Cells(i, j).Value
Else
sLine = sLine & Cells(i, j).Value & Deliminator
End If
Next j
If i = 1 Then i = 2
Print #FileNumber, sLine
sLine = ""
Next i
Close #FileNumber
MsgBox "File generated"
End Sub
In the result I got this text file in that format:
=|1|SALARIES|PSA_etablissement|PSA_SALARIE|
=|1|SALARIES|001|10635|
=|1|SALARIES|001|10637|
But I want my text file to be like that:
$=|1|SALARIES|PSA_etablissement|PSA_SALARIE|
=|1|SALARIES|001|10635|
=|1|SALARIES|001|10637|
and I want to add those lines in the beginning of the text file:
$|0|Les Données de SALARIES
=|0|Les Données de SALARIES
Try this routine:
Added the two lines outside your for loop.
Also '&' and '=' is the only difference in that line, so take it as a variable without those symbols.
Sub ExceltoText()
Dim FileName As String, sLine As String, Deliminator As String
Dim x As String, y As String, z As String
Dim LastCol As Integer, LastRow As Integer, FileNumber As Integer
FileName = "C:\Users\Administrateur\Desktop\App vba\ExcToTxt.txt"
Deliminator = "|"
x = "$=|1|SALARIES|PSA_etablissement|PSA_SALARIE|"
y = "|0|Les Données de SALARIES"
z = "=|1|SALARIES|"
LastCol = ActiveSheet.Cells.Cells(1, Columns.Count).End(xlToLeft).Column
LastRow = ActiveSheet.Cells.Cells(Rows.Count, 1).End(xlUp).Row
FileNumber = FreeFile
Open FileName For Output As FileNumber
Print #FileNumber, "$" & y
Print #FileNumber, "=" & y
Print #FileNumber, x
For i = 1 To LastRow
For j = 1 To LastCol
If j = LastCol Then
sLine = z & sLine & Cells(i, j).Value
Else
sLine = sLine & Cells(i, j).Value & Deliminator
End If
Next j
Print #FileNumber, sLine
sLine = ""
Next i
Close #FileNumber
MsgBox "File generated"
End Sub
To add the lines at the beginning of the file, just before the FOR loop add:
Print #FileNumber, x
Print #FileNumber, y
To put that dollar sign before only the first line while iterating change:
If i = 1 Then i = 2
Print #FileNumber, sLine
sLine = ""
To:
If i = 1 Then
i = 2
Print #FileNumber, "$" & sLine
Else
Print #FileNumber, sLine
End If
sLine = ""
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 want to append a range from "A2:B" & LastRow to a log txt file with a ; delimiter.
For now I know how to read from separate cells but not from "A2:B"
Column A = text
Column B2:B = =IF(A2="","",1)
My code:
Dim strData As String
Dim strLine As String
strData = ""
Open "\\x-ap01\Log.txt" For Input As #1
While EOF(1) = False
Line Input #1, strLine
strData = strData + strLine & vbCrLf
Wend
strData = strData + Cells(2, 1) & ";" & Cells(2, 2) & ";"
Close #1
Open "\\x-ap01\Log.txt" For Output As #1
Print #1, strData
Close #1
Do you mean like this?
Sub x()
Dim strData As String
Dim strLine As String
Dim lastrow As Long
Dim r As Long
lastrow = Range("A" & Rows.Count).End(xlUp).Row
Open "\\x-ap01\Log.txt" For Append As #1
For r = 2 To lastrow
If Cells(r, 1) <> vbNullString Then
strData = strData & Cells(r, 1) & ";" & Cells(r, 2) & ";"
strData = strData & strLine & vbCrLf
End If
Next r
Print #1, strData
Close #1
End Sub
Im currently working on a tool that will enable me to create my specific profile for entries present in my Excel File.
Assuming that I have these values:
Male:
And I want to generate a text file like this one below. There must be separate filename for both female and male and one file per row only.
I currently have this code below:
Sub toFile()
Dim FilePath As String, CellData As String, LastCol As Long, LastRow As Long
Dim Filenum As Integer
LastCol = ActiveSheet.UsedRange.SpecialCells(xlCellTypeLastCell).Column
LastRow = ActiveSheet.UsedRange.SpecialCells(xlCellTypeLastCell).Row
For i = 1 To LastRow
FilePath = Application.DefaultFilePath & "\" & Trim(ActiveSheet.Cells(i, 1).Value) & ".xpd"
Filenum = FreeFile
Open FilePath For Output As Filenum
CellData = ""
For j = 2 To LastCol
CellData = Trim(ActiveSheet.Cells(i, j).Value)
Write #Filenum, CellData
Next j
Close #Filenum
Next i
MsgBox ("Done")
End Sub
Sample Output of this code:
How can I achieve my expected output mentioned above?
Here is the final code which will create two files and won't write values where cells are blank:
Sub toFile()
Dim FilePath As String, CellData As String, LastCol As Long, LastRow As Long
Dim Filenum As Integer
LastCol = ActiveSheet.UsedRange.SpecialCells(xlCellTypeLastCell).Column
LastRow = ActiveSheet.UsedRange.SpecialCells(xlCellTypeLastCell).Row
For i = 2 To LastRow
FilePath = Application.DefaultFilePath & "\" & Trim(ActiveSheet.Cells(i, 1).Value) & ".TXT"
Filenum = FreeFile
Open FilePath For Output As Filenum
CellData = ""
For j = 2 To LastCol
If Trim(ActiveSheet.Cells(i, j).Value) <> "" Then
CellData = Trim(ActiveSheet.Cells(1, j).Value) & ": " & Trim(ActiveSheet.Cells(i, j).Value)
Write #Filenum, CellData
End If
Next j
Close #Filenum
Next i
MsgBox ("Done")
End Sub
Use the below code
Change the code
For i = 2 To LastRow
and
celldata = Trim(ActiveSheet.Cells(1, j)) & ": " & Trim(ActiveSheet.Cells(i, j).Value)