Whenever I run the macro text file is generated but there is space after every line., How do I fix it?
Here it is my code
Sub test()
Dim txt As String, i As Long, rng As Range
Set rng = Range("A1:C500")
For i = 1 To rng.Rows.Count
With WorksheetFunction
txt = txt & vbCrLf & Join(.Transpose(.Transpose(rng.Rows(i).Value)), vbTab)
End With
Next
Open "c:\test\test.txt" For Output As #1
Print #1, Mid$(txt, 2)
Close #1
End Sub
Try Triming the text. The code should be something like this:
txt = txt & vbCrLf & Trim(Join(.Transpose(.Transpose(rng.Rows(i).Value)), vbTab))
Related
I am trying to write a macro whereby it checks all sheetnames for certain criteria (specifically here the inclusion of 'TUBA' in the name) and, if met, exports a range on those sheets to text files with the sheet name as filename. I am getting error 91: object variable or With block variable not set, and on debugging the If WS.name Like "TUBA*" Then line is highlighted. How can I fix this? The problematic code is below. I previously had success with almost the same code but without the If statement (shown in the second block below), so I assume its the way I am adding this in. If i need to set a variable, which one have i missed?
Sub ExportTubatoText()
Dim c As Range, r As Range
Dim output As String
Dim lngcount As Long
Dim WS As Worksheet
Dim Name As String
Dim strFolder As String
strFolder = GetFolder("L:TUBA\")
'\ dialog box opens in that folder as default
'strFolder = GetFolder("L:TUBA\")
If strFolder <> "" Then
MsgBox strFolder
End If
For Each sh In ThisWorkbook.Worksheets
'if worksheet has 'TUBA' in the title, then it is exported to text
If WS.Name Like "TUBA*" Then
output = ""
For Each r In sh.Range("F3:F200").Rows
For Each c In r.Cells
output = output & c.Value
Next c
output = output & vbNewLine
Next r
Name = sh.Name
Open strFolder & "\" & Name & ".txt" For Output As #1
Print #1, output
Close
End If
Next
End Sub
Successful code:
For Each sh In ThisWorkbook.Worksheets
output = ""
For Each r In sh.Range("O2:O500").Rows
For Each c In r.Cells
output = output & c.Value
Next c
output = output & vbNewLine
Next r
Name = sh.Name
Open strFolder & "\" & Name & ".txt" For Output As #1
Print #1, output
Close
Next
Try changing
If WS.Name Like "TUBA*" Then
to
If sh.Name Like "TUBA*" Then
Or change your For Each to WS in...
Note: this is just an idea and not an answer as #Rdster explain why your first code dos not work.
If you are working with only one column (like your both codes do) you can replace this part of your code:
For Each r In sh.Range("F3:F200").Rows
For Each c In r.Cells
output = output & c.Value
Next c
output = output & vbNewLine
Next r
with this line:
output = Join(Application.Transpose(sh.Range("F3:F200").Value), vbNewLine)
I'm needing to export to a text file without " marks example
exporting this
Create bts; sitemask = "0110"; pcmlink = 40
exports like this
"Create bts; sitemask = ""0110""; pcmlink = 40"
This code I found for doing this works and strips off the " marks
Sub Export()
Dim r As Range, c As Range
Dim sTemp As String
Open "c:\MyOutput.txt" For Output As #1
For Each r In Selection.Rows
sTemp = ""
For Each c In r.Cells
sTemp = sTemp & c.Text & Chr(9)
Next c
'Get rid of trailing tabs
While Right(sTemp, 1) = Chr(9)
sTemp = Left(sTemp, Len(sTemp) - 1)
Wend
Print #1, sTemp
Next r
Close #1
End Sub
This code works from selecting the cells running the code which exports the current selected cells, my question is this how can I modify this code to work on a predefined cell range eg A1 to A10 for exporting rather than the current selection?
Also is there away to modify the file path to save in the same directory as the active excel sheet instead of having to put the full file path"C:\MyOutput.txt" instead "MyOutput.txt" (or something like that)?
Many thanks
The modification would be pretty obvious: assuming that your workbook is named "ThisWorbook.xls", and the worksheet that holds the range you want to write to file is named "This Worksheet", then you'll adapt the code like
' ... Previous original code
' Open file in the same folder as the worksheet
Open Workbooks("ThisWorbook.xls").Path & "\MyOutput.txt" For Output As #1
' Loop in predefined range instead of current selection
For Each r In Worksheets("This Worksheet").Range("A1:A10").Rows
' ... Following original code
Don't open it directly:
Sub Export()
Dim r As Range, c As Range
Dim sTemp As String
Dim fn As Long
Dim sfilename
sfilename = "C:\MyOutput.txt"
fn = FreeFile
Open sfilename For Output As #fn
For Each r In Selection.Rows
sTemp = ""
For Each c In r.Cells
sTemp = sTemp & c.Text & Chr(9)
Next c
'Get rid of trailing tabs
While Right(sTemp, 1) = Chr(9)
sTemp = Left(sTemp, Len(sTemp) - 1)
Wend
Print #fn, sTemp
Next r
Close #fn
End Sub
You have an excel file, and when You save the file as .txt the Quotation marks appear. Mark the data ( CTRL + A), copy the data to clipboard ( CTRL + C).
Open notepad, paste the data ( CTRL + V) save the data...
There, data without Quotation marks.
From what I've seen in VBA 2010, the Write function creates output with the unwanted wrapping quotation characters.
However the similar Print function writes to the file without the quotes.
But if you wanted quotes in the text file, you could create a string concatenation at the quote locations to add them in with Chr(39), eg.
For an output of:
Create bts; sitemask = "0110"; pcmlink = 40
Code as:
"Create bts; sitemask = " & Chr(39) & "0110" & Chr(39) & "; pcmlink = 40"
Save your file as ASCII file not unicode
fso.CreateTextFile(path, True, False)
I have a source spreadsheet in Excel with 450-or-so rows. Each row has 6 columns of data, and I need to create a separate file from each row with the filename = Column A and the contents = Columns B-G with a line break between them.
For example, I'm trying this but getting an error "File not found":
Sub DataDump()
Dim X
Dim lngRow As Long
Dim StrFolder As String
StrFolder = "/Users/danielfowler/Documents/_users_text_6.16"
X = Range([a1], Cells(Rows.Count, 2).End(xlUp))
For lngRow = 1 To UBound(X)
Open StrFolder & "\" & X(lngRow, 1) & ".txt" For Output As #1
Write #1, X(lngRow, 2)
Close #1
Next
End Sub
I see a half dozen questions like this already here on StackOverflow...
Create text Files from every row in an Excel spreadsheet
Write each Excel row to new .txt file with ColumnA as file name
Outputting Excel rows to a series of text files with spaces in filenames using VBA
Outputting Excel rows to a series of text files
But every one of these solutions returns a different error for me. I'm using Excel for Mac 2011, v14.4.2.
Sub VBA_Print_to_a_text_file()
Dim strFile_Path As String
strFile_Path = "C:\temp\test.txt" ‘Change as per your test folder path
Open strFile_Path For Output As #1
Print #1, "This is my sample text"
Close #1
End Sub
This outputs a text file for each row with column A as the title and columns B to the last column as the content for each file. You can change the directory to whatever you want but currently it saves the text file(s) to the same directory as the Excel file. You can also change the file extension to whatever you want.
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
As for the breaks in between each line, unfortunately I'm not experienced enough to know how to do that.
I want to read a file written by c where each line is seperated by /n. I want read that file and compare it with data on excel.
I used input #1, data .
But I want to read a line with ","(comma), So i used Line Input #1, data.
when i check that "data" with data on excel, though they are same, its saying false.
Activecell="KVK"
Line Input #1,data
msgbox ActiveCell=data
is printing false even if data is KVK.
Thanks and Regards for Helping in advance,
Vamshi krishna
Dim fpath, fnum, s
fpath = Application.GetOpenFilename
fnum = FreeFile
Open fpath For Input As fnum
Range("A1").Activate
Do While Not EOF(fnum)
Line Input #fnum, s
'Input #fnum, s
MsgBox s & " = " & ActiveCell & " "
MsgBox s = ActiveCell
ActiveCell.Offset(1, 0).Select
Loop
.txt has
12
13
14
data in first column
12
13
14
Try below code :
Sub InputImage()
Dim FileNum As Integer, i As Integer
Dim fpath As String, s As String, cellVal As String
fpath = Application.GetOpenFilename
FileNum = FreeFile()
Open fpath For Input As #FileNum
i = 1
While Not EOF(FileNum)
Line Input #FileNum, s ' read in data 1 line at a time
cellVal = CStr(Cells(i, 1).Value)
MsgBox s & " = " & cellVal & " "
MsgBox s = cellVal
ActiveCell.Offset(1, 0).Select
i = i + 1
Wend
End Sub
If you check in watch window the data type of cell(i,1).Value is showing Variant/Double. So there is need to convert into string.
Or use the TextStream in the Scripting library, it's much better.
And please close the file when your finished with it, you must be the type of person who doesn't put the milk back in the fridge when your finished with it and just spoils it for everyone.
I want to show 7000 files content that are in a folder and in excel?
I have a found a piece of code that helped me but its only reading one by one. However, I want to read 7000 all in one go. Please help.
Option Explicit
Sub Import_TXT_File()
Dim strg As Variant
Dim EntireLine As String
Dim FName As String
Dim i As String
Application.ScreenUpdating = False
FName = Application.GetOpenFilename("Text Files (*.txt), *.txt", , "Choose File to Import")
Open FName For Input Access Read As #1
i = 1
While Not EOF(1)
Line Input #1, EntireLine
strg = EntireLine
'Change "Sheet1" to relevant Sheet Name
'Change "A" to the relevant Column Name
Sheets("Sheet1").Range("A" & i).Value = strg
i = i + 1
Wend
EndMacro:
On Error GoTo 0
Application.ScreenUpdating = True
Close #1
End Sub
user1185158
The code which you are using will be very slow when you are reading 7000 files. Also there is no code which can read 7000 files in 1 go. You will have to loop through the 7000 files. However there is one good news :) Instead of looping through every line in the text file, you can read the entire file into an array and then write it to excel. For example see this code which is very fast as compared to the code that you have above.
TRIED AND TESTED
Sub Sample()
Dim MyData As String, strData() As String
Open "C:\MyFile.Txt" For Binary As #1
MyData = Space$(LOF(1))
Get #1, , MyData
Close #1
strData() = Split(MyData, vbCrLf)
End Sub
Now using the same code in a loop we can write it into an Excel File
'~~> Change this to the relevant path
Const strPath As String = "C:\Temp\"
Sub Sample()
Dim ws As Worksheet
Dim MyData As String, strData() As String
Dim WriteToRow As Long, i As Long
Dim strCurrentTxtFile As String
Set ws = Sheets("Sheet1")
'~~> Start from Row 1
WriteToRow = 1
strCurrentTxtFile = Dir(strPath & "*.Txt")
'~~> Looping through all text files in a folder
Do While strCurrentTxtFile <> ""
'~~> Open the file in 1 go to read it into an array
Open strPath & strCurrentTxtFile For Binary As #1
MyData = Space$(LOF(1))
Get #1, , MyData
Close #1
strData() = Split(MyData, vbCrLf)
'~~> Read from the array and write to Excel
For i = LBound(strData) To UBound(strData)
ws.Range("A" & WriteToRow).Value = strData(i)
WriteToRow = WriteToRow + 1
Next i
strCurrentTxtFile = Dir
Loop
MsgBox "Done"
End Sub
What the above code does is that it reads the contents of the 7000 text files in sheet 1 (one below the other). Also I have not included error handling. Please do that.
CAUTION: If you are reading heavy text files, say, each file has 10000 lines then you will have to tweak the code in the above scenario as you will get errors. for example
7000 Files * 10000 lines = 70000000 lines
Excel 2003 has 65536 rows and Excel 2007/2010 has 1048576 rows.
So once the WriteRow reaches the maximum row, you might want to read the text file contents into Sheet 2 and so on...
HTH
Sid
Taking Siddharth's solution a little further. You probably don't want to write each row one at a time, calls to the worksheet are extremely slow in Excel, it is better to do any looping in memory and write back in one fell swoop :)
Sub Sample()
Dim ws As Worksheet
Dim MyData As String, strData() As String, strData2() As String
Dim WriteToRow As Long, i As Long
Dim strCurrentTxtFile As String
Set ws = Sheets("Sheet1")
'~~> Start from Row 1
WriteToRow = 1
strCurrentTxtFile = Dir(strPath & "*.Txt")
'~~> Looping through all text files in a folder
Do While strCurrentTxtFile <> ""
'~~> Open the file in 1 go to read it into an array
Open strPath & strCurrentTxtFile For Binary As #1
MyData = Space$(LOF(1))
Get #1, , MyData
Close #1
strData = Split(MyData, vbCrLf)
'Resize and transpose 1d array to 2d
ReDim strData2(1 To UBound(strData) + 1, 1 To 1)
For i = 1 To UBound(strData)
strData2(i, 1) = strData(i - 1)
Next i
Sheet1.Range("A1").Offset(Sheet1.Rows.Count - 1, 0).End(xlUp).Offset(1).Resize(UBound(strData), 1).Value = strData2
strCurrentTxtFile = Dir
Loop
MsgBox "Done"
End Sub