I wrote a script that loops through hundreds of simple text files. The script opens a file, pastes it into Excel, extracts some data, deletes the text file and moves on to the next one. It worked perfectly until few days ago, when it opened one of those files (it's happening only on that one specific file) after pasting it into Excel I've noticed that one of the lines ended up abruptly...
If I will Debug.Print that file I can see that everything is in there, but if I will paste it into Excel, the same line ends abruptly...
Does anyone knows what might be causing that? What's weirder, if I will manually copy and paste the text into a new text file, Excel processes that without any problem...
Below is a code that deals with those text files.
MyFolder = "C:\Test\"
StrFile = Dir(MyFolder & "tempfile.txt")
Open MyFolder & StrFile For Binary As #1
MyData = Space$(LOF(1))
Get #1, , MyData
Close #1
strData() = Split(MyData, vbCrLf)
LineNumber = 1
For xy = LBound(strData) To UBound(strData)
Debug.Print strData(xy) 'THIS WORKS!
Range("A" & LineNumber).Value = strData(xy) 'THIS DOESN'T!
LineNumber = LineNumber + 1
Next xy
Thank you!
I found what was causing this problem! I opened the text file in a Word and noticed that the line that was abruptly cut had some weird symbols (four empty squares?) that were not visible in Notepad. So then I started opening all the other files in Word and neither one of them had them.
So then I started reading about "non printable characters" and came up with this solution... I'm replacing each ASCII(0) (NULL) character with a blank space.
I'm posting it in case someone else will have to deal with a problem like that:
MyFolder = "C:\Test\"
StrFile = Dir(MyFolder & "tempfile.txt")
Open MyFolder & StrFile For Binary As #1
MyData = Space$(LOF(1))
Get #1, , MyData
Close #1
strData() = Split(MyData, vbCrLf)
LineNumber = 1
For Each sData In strData
sData = Replace(sData, Chr(0), " ")
Range("A" & LineNumber).Value = sData 'Now it works!!
LineNumber = LineNumber + 1
Next
Thank you for your help everybody!
(Need formatting of an answer, but this is really a comment)
Give this a try:
Sub tgr()
Dim oFSO As Object
Dim sFolderPath As String
Dim sFileName As String
Dim sFullText As String
Dim aOutput() As String
Set oFSO = CreateObject("Scripting.FileSystemObject")
sFolderPath = "C:\Test\"
sFileName = Dir(sFolderPath & "tempfile.txt")
sFullText = oFSO.OpenTextFile(sFolderPath & sFileName).ReadAll
aOutput = Split(sFullText, vbCrLf)
With Range("A1").Resize(UBound(aOutput) - LBound(aOutput) + 1)
.Value = Application.Transpose(aOutput)
End With
End Sub
If that still fails, you'll need to provide the problem text file.
Related
Hi there so I finished the section of a program which calculates and exports a csv with results. (ends up about 1600 csv files) each having only 1 column and between 20 and 0 rows. I would like my MS Access VBA program to join them together into one larger CSV. So Same header only once at the top of the new file.
The program i have so far seems to fall over at the part where it tries to import the Reg. Number of the File.
Dim db As DAO.Database
Set db = CurrentDb
MTH = Format(Date, "mmm")
UserInput = InputBox("Enter Country Code")
Dim strSourcePath As String
Dim strDestPath As String
Dim strFile As String
Dim strData As String
Dim x As Variant
Dim Cnt As Long
Dim r As Long
Dim c As Long
Dim wks As Excel.Worksheet
Application.Echo False
'Change the path to the source folder accordingly
strSourcePath = "Q:\CCNMACS\AWD" & CTRY
If Right(strSourcePath, 1) <> "\" Then strSourcePath = strSourcePath & "\"
'Change the path to the destination folder accordingly
strDestPath = "Q:\CCNMACS\AWDFIN"
If Right(strDestPath, 1) <> "\" Then strDestPath = strDestPath & "\"
strFile = Dir(strSourcePath & "*.csv")
Do While Len(strFile) > 0
Cnt = Cnt + 1
If Cnt = 1 Then
r = 1
Else
r = Cells(Rows.Count, "A").End(xlUp).Row + 1
End If
Open strSourcePath & strFile For Input As #1
If Cnt > 1 Then
Line Input #1, strData
End If
Do Until EOF(1)
Line Input #1, strData
x = Split(strData, ",")
For c = 0 To UBound(x)
wks.Cells(r, c + 1).Value = Trim(x(c)) 'Error is here: Run time error '91': Object variable or With Block variable not set
Next c
r = r + 1
Loop
Close #1
Name strSourcePath & strFile As strDestPath & strFile
strFile = Dir
Loop
Application.Echo True
If Cnt = 0 Then _
MsgBox "No CSV files were found...", vbExclamation
Your question isn't absolutely definitive as to what you're trying to do, but if I understand correctly, you just need to append several files to the end of each other, to make "one big CSV".
If that's true then there are several ways to do this a lot simpler than using VBA. .CSV files are just plain text files with comma's separating each field, and a .CSV filename extension.
Personally I would use Notepad++ (I assume it's capable of this; it does everything else), or perhaps even easier, I would use the Windows Command Prompt.
Let's say you have a folder with files:
File1.csv
File2.csv
File3.csv
...etc
Open the Windows Command Prompt. (One way is with the Windows key + R, then type cmd and hit Enter.)
Change directory with to the file location using cd (same as ChDir).
(For example, you might use cd c:\users\myFolder,
and then hit Enter)
To combine all CSV's in the folder into one, you could use a command like:
copy *.csv combinedfile.csv
That's it!
A file is created named combinedfile.csv. You can open in Excel or a text editor (like Notepad) to double-check it and adjust manually if necessary.
Obviously there are many ways you could vary the command, like if you only wanted the files that start with the word File you could use:
copy file*.csv combinedFile.csv
This should do what you want.
Sub Import()
Dim strPathFile As String, strFile As String, strPath As String
Dim strTable As String
Dim blnHasFieldNames As Boolean
' Change this next line to True if the first row in EXCEL worksheet
' has field names
blnHasFieldNames = True
' Replace C:\Documents\ with the real path to the folder that
' contains the EXCEL files
strPath = "C:\your_path_here\"
' Replace tablename with the real name of the table into which
' the data are to be imported
strTable = "Table1"
strFile = Dir(strPath & "*.csv")
Do While Len(strFile) > 0
strPathFile = strPath & strFile
DoCmd.TransferText acImportDelim, "", strTable, strPathFile, blnHasFieldNames
' Uncomment out the next code step if you want to delete the
' EXCEL file after it's been imported
' Kill strPathFile
strFile = Dir()
Loop
End Sub
See the links below for additional details pertaining to this topic.
https://anthonysmoak.com/2018/04/10/how-to-fix-an-import-specification-error-in-microsoft-access/
https://www.oakdome.com/programming/MSAccess_ExportSpecifications_TransferText_To_CSV.php
I've looked and found a little help so far but I'm stuggling with the for each logic for this Excel Macro I'm trying to make.
Basically I have 4 columns of data. Column A has the name of something and column D has either TRUE or FALSE.
I would like a macro wired to a button that creates a new text file in a given directory named after the content of Col A but only if Col D in that row is labled as "TRUE".
For example if I have the following.
ColA = Test ColD = TRUE
ColA = Test2 ColD = FALSE
ColA = Test3 ColD = TRUE
I will get 2 text files anmed Test.txt and Test3.txt.
I know I need a for each loop to look through the range of a1-d(whatever number) and then when D = True do a SaveAs I guess??
This is the code I have so far (yes I know it's very incomplete but this is as far as my logic got before hitting a wall).
Dim fileName As String
Dim filePath As String
Dim curCell As Object
Dim hideRange As Range
filePath = "C:\ExcelTest\"
hideRange = Range("D1:D1048576")
fileName = *Content of Cell A from this Row*
For Each Row In Range("A1:D1048576")
IF curCell.value In Range hideRange = "TRUE"
Then curCell.SaveAs fileName & ".txt, xlTextWindows
Any help or even pointing me in the right direction would be great. I searched around a bit for some examples and couldn't find anything that really matched what I wanted to do.
You are pretty close, but you are looping one hell of a lot of cells there.
Here is the code to loop the rows, this stops at the last populated cell in the column.
Sub LoopRows()
dim sht as worksheet
set sht = Thisworkbook.Sheets("Name of Worksheet")
'loop from row 1 to the last row containing data
For i = 1 To sht.Range("A:A").End(xlDown).Row
'check the value in column 4 for this row (i)
If sht.Cells(i, 4).Text = "TRUE" Then
CreateFile sht.Cells(i, 1).Value
End If
Next i
End Sub
For writing the file, to keep it simple it would reference Microsoft scripting runtime and do it as follows:
Sub CreateFile(FileName As String)
Dim fso As New FileSystemObject
fso.CreateTextFile "c:\temp\" & FileName & ".txt", True
End Sub
EDIT
I can't see why you aren't getting a file created, my tests work fine for me on a windows machine.
Can you please try the following code alone in a button and see if it opens a text file?
Dim fso As New FileSystemObject
fso.CreateTextFile "c:\temp\testfso.txt"
Shell "C:\WINDOWS\notepad.exe c:\temp\testfso.txt", vbMaximizedFocus
EDIT 2
Try this, and see if it opens the text file..
Sub CreateFile(FileName As String)
Dim fso As New FileSystemObject
Dim fName as String
fName = "c:\temp\" & FileName & ".txt"
fso.CreateTextFile fName, True
Shell "C:\WINDOWS\notepad.exe " & fName, vbMaximizedFocus
End Sub
What you are looking for is something like this:
Sub test()
Dim filePath As String
filePath = "C:\ExcelTest\"
Dim xRow As Variant
For Each xRow In Range("A1:D100").Rows
If xRow(1, 4).Value = "TRUE" Then
Open filePath & xRow(1, 1) & ".txt" For Output As #1
Write #1, xRow(1, 2), xRow(1, 3)
Close #1
End If
Next
End Sub
While it works without errors, I would not use it as it is right now.
If you have any questions, just ask.
EDIT
I've run some tests and noticed windows prevents me to create files inside specific folders... pls try this as a new sub and run it:
Sub testForText()
Open Environ("AppData") & "\Testing.txt" For Output As #1
Write #1, "dada"
Close #1
Shell "notepad.exe " & Environ("AppData") & "\Testing.txt", vbNormalFocus
End Sub
Then tell me if notepad opens up with "Testing.txt"
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 have a excel sheet which has data in column A.There are many special characters in the cells.When I save the sheet in .txt format I get inverted commas at the start of each line. I tried both manually and by macro saving the file in .txt format.Why is it so? How to remove them?
I am not able to remove the quotes.
Attaching a pic
I see this question is already answered, but wanted to offer an alternative in case someone else finds this later.
Depending on the required delimiter, it is possible to do this without writing any code. The original question does not give details on the desired output type but here is an alternative:
PRN File Type
The easiest option is to save the file as a "Formatted Text (Space Delimited)" type.
The VBA code line would look similar to this:
ActiveWorkbook.SaveAs FileName:=myFileName, FileFormat:=xlTextPrinter, CreateBackup:=False
In Excel 2007, this will annoyingly put a .prn file extension on the end of the filename, but it can be changed to .txt by renaming manually.
In Excel 2010, you can specify any file extension you want in the Save As dialog.
One important thing to note: the number of delimiters used in the text file is related to the width of the Excel column.
Observe:
Becomes:
This code does what you want.
LOGIC
Save the File as a TAB delimited File in the user temp directory
Read the text file in 1 go
Replace "" with blanks and write to the new file at the same time.
CODE
Private Declare Function GetTempPath Lib "kernel32" Alias "GetTempPathA" _
(ByVal nBufferLength As Long, ByVal lpBuffer As String) As Long
Private Const MAX_PATH As Long = 260
'~~> Change this where and how you want to save the file
Const FlName = "C:\Users\Siddharth Rout\Desktop\MyWorkbook.txt"
Sub Sample()
Dim tmpFile As String
Dim MyData As String, strData() As String
Dim entireline As String
Dim filesize As Integer
'~~> Create a Temp File
tmpFile = TempPath & Format(Now, "ddmmyyyyhhmmss") & ".txt"
ActiveWorkbook.SaveAs Filename:=tmpFile _
, FileFormat:=xlText, CreateBackup:=False
'~~> Read the entire file in 1 Go!
Open tmpFile For Binary As #1
MyData = Space$(LOF(1))
Get #1, , MyData
Close #1
strData() = Split(MyData, vbCrLf)
'~~> Get a free file handle
filesize = FreeFile()
'~~> Open your file
Open FlName For Output As #filesize
For i = LBound(strData) To UBound(strData)
entireline = Replace(strData(i), """", "")
'~~> Export Text
Print #filesize, entireline
Next i
Close #filesize
MsgBox "Done"
End Sub
Function TempPath() As String
TempPath = String$(MAX_PATH, Chr$(0))
GetTempPath MAX_PATH, TempPath
TempPath = Replace(TempPath, Chr$(0), "")
End Function
SNAPSHOTS
Actual Workbook
After Saving
Ummm, How about this.
Copy your cells.
Open Notepad.
Paste.
Look no quotes, no inverted commas, and retains special characters, which is what the OP asked for. Its also delineated by carriage returns, same as the attached pict which the OP didn't mention as a bad thing (or a good thing).
Not really sure why a simple answer, that delivers the desired results, gets me a negative mark.
I just spent the better part of an afternoon on this
There are two common ways of writing to a file, the first being a direct file access "write" statement. This adds the quotes.
The second is the "ActiveWorkbook.SaveAs" or "ActiveWorksheet.SaveAs" which both have the really bad side effect of changing the filename of the active workbook.
The solution here is a hybrid of a few solutions I found online. It basically does this:
1) Copy selected cells to a new worksheet
2) Iterate through each cell one at a time and "print" it to the open file
3) Delete the temporary worksheet.
The function works on the selected cells and takes in a string for a filename or prompts for a filename.
Function SaveFile(myFolder As String) As String
tempSheetName = "fileWrite_temp"
SaveFile = "False"
Dim FilePath As String
Dim CellData As String
Dim LastCol As Long
Dim LastRow As Long
Set myRange = Selection
'myRange.Select
Selection.Copy
'Ask user for folder to save text file to.
If myFolder = "prompt" Then
myFolder = Application.GetSaveAsFilename(fileFilter:="XML Files (*.xml), *.xml, All Files (*), *")
End If
If myFolder = "False" Then
End
End If
Open myFolder For Output As #2
'This temporarily adds a sheet named "Test."
Sheets.Add.Name = tempSheetName
Sheets(tempSheetName).Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
LastCol = ActiveSheet.UsedRange.SpecialCells(xlCellTypeLastCell).Column
LastRow = ActiveSheet.UsedRange.SpecialCells(xlCellTypeLastCell).Row
For i = 1 To LastRow
For j = 1 To LastCol
CellData = CellData + Trim(ActiveCell(i, j).Value) + " "
Next j
Print #2, CellData; " "
CellData = ""
Next i
Close #2
'Remove temporary sheet.
Application.ScreenUpdating = False
Application.DisplayAlerts = False
ActiveWindow.SelectedSheets.Delete
Application.DisplayAlerts = True
Application.ScreenUpdating = True
'Indicate save action.
MsgBox "Text File Saved to: " & vbNewLine & myFolder
SaveFile = myFolder
End Function
The answer from this question provided the answer to this question much more simply.
Write is a special statement designed to generate machine-readable
files that are later consumed with Input.
Use Print to avoid any fiddling with data.
Thank you user GSerg
I have the same problem: I have to make a specific .txt file for bank payments out of an excel file. The .txt file must not be delimeted by any character, because the standard requires a certain number of commas after each mandatory field.
The easiest way of doing it is to copy the contect of the excel file and paste it in notepad.
I was using Write #1 "Print my Line" instead I tried Print #1, "Print my Line" and it give me all the data without default Quote(")
Dim strFile_Path As String
strFile_Path = ThisWorkbook.Path & "\" & "XXXX" & VBA.Format(VBA.Now, "dd-MMM-yyyy hh-mm") & ".txt"
Open strFile_Path For Output As #1
Dim selectedFeature As String
For counter = 7 To maxNumberOfColumn
selectedFeature = "X"
Print #1, selectedFeature
'Write #1, selectedFeature
Next counter
Close #1
PRN solution works only for simple data in the cells, for me it cuts only first 6 signs from 200 characters cell.
These are the main file formats in Excel 2007-2016,
Note: In Excel for the Mac the values are +1
51 = xlOpenXMLWorkbook (without macro's in 2007-2016, xlsx)
52 = xlOpenXMLWorkbookMacroEnabled (with or without macro's in 2007-2016, xlsm)
50 = xlExcel12 (Excel Binary Workbook in 2007-2016 with or without macro's, xlsb)
56 = xlExcel8 (97-2003 format in Excel 2007-2016, xls)
From XlFileFormat FileFormat Property
Keep in mind others FileFormatNumbers for SaveAs method:
FileExtStr = ".csv": FileFormatNum = 6
FileExtStr = ".txt": FileFormatNum = -4158
FileExtStr = ".prn": FileFormatNum = 36
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