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
Related
I've got a folder which contains .txt files (they contain PHI, so I can't upload the .txt file, or an example without PHI, or even any images of it). I need an excel macro, which will allow the user to choose the folder containing the file, and will then insert the .txt file data into a new excel workbook, format the rows and columns appropriately, and finally save the file to the same folder that the source was found in.
So far I've got all of that working except for the formatting of rows and columns. As of now, the .txt data is inserted to a new workbook & worksheet, but I can't seem to figure out how to get rid of rows I don't need, or how to get the columns formatted appropriately.
Again, I can't upload the .txt file (or anything) because the Healthcare organization I work for blocks it - even if I've removed all PHI.
Below is the macro I've created so far:
Private Sub CommandButton2_Click()
On Error GoTo err
'Allow the user to choose the FOLDER where the TEXT file(s) are located
'The resulting EXCEL file will be saved in the same location
Dim FldrPath As String
Dim fldr As FileDialog
Dim fldrChosen As Integer
Set fldr = Application.FileDialog(msoFileDialogFolderPicker)
With fldr
.Title = "Select a Folder containing the Text File(s)"
.AllowMultiSelect = False
.InitialFileName = "\\FILELOCATION"
fldrChosen = .Show
If fldrChosen <> -1 Then
MsgBox "You Chose to Cancel"
Else
FldrPath = .SelectedItems(1)
End If
End With
If FldrPath <> "" Then
'Make a new workbook
Dim newWorkbook As Workbook
Set newWorkbook = Workbooks.Add
'Make worksheet1 of new workbook active
newWorkbook.Worksheets(1).Activate
'Completed files are saved in the chosen source file folder
Dim CurrentFile As String: CurrentFile = Dir(FldrPath & "\" & "*.txt")
Dim strLine() As String
Dim LineIndex As Long
Application.ScreenUpdating = False
Application.DisplayAlerts = False
While CurrentFile <> vbNullString
'How many rows to place in Excel ABOVE the data we are inserting
LineIndex = 0
Close #1
Open FldrPath & "\" & CurrentFile For Input As #1
While Not EOF(1)
'Adds number of rows below the inserted row of data
LineIndex = LineIndex + 1
ReDim Preserve strLine(1 To LineIndex)
Line Input #1, strLine(LineIndex)
Wend
Close #1
With ActiveSheet.Range("A1").Resize(LineIndex, 1)
.Value = WorksheetFunction.Transpose(strLine)
.TextToColumns Other:=True, OtherChar:="|"
End With
ActiveSheet.UsedRange.EntireColumn.AutoFit
ActiveSheet.Name = Replace(CurrentFile, ".txt", "")
ActiveWorkbook.SaveAs FldrPath & "\" & Replace(CurrentFile, ".txt", ".xls"), xlNormal
ActiveWorkbook.Close
CurrentFile = Dir
Wend
Application.DisplayAlerts = True
Application.ScreenUpdating = True
End If
Done:
Exit Sub
err:
MsgBox "The following ERROR Occurred:" & vbNewLine & err.Description
ActiveWorkbook.Close
End Sub
Any ideas of how I can delete entire lines from being brought into excel?
And how I can format the columns appropriately? So that I'm not getting 3 columns from the .txt file all jammed into 1 column in the resulting excel file?
Thanks
I'd recommend you not to re-invent the wheel. Microsoft provides an excellent add-on to accomplish this task, Power Query.
It lets you to load every file in a folder and process it in bulks.
Here you have a brief introduction of what can do for you.
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.
I have searched the internet, and can't really seem to find the exact solution that I need. I have a third party program that generates a report in .csv format. Unfortunately, when you open the .csv file directly in Excel, the format comes out funky with some data in column A, and some data in column B. However, if you open the .csv in notepad, and then paste it to Excel, the data comes in fine. I have the below code which will open the file in Notepad, but have no idea how to select and and copy it into cell A1 in Excel. Thank you very much in advance for the help.
Dim FileToOpen
If MsgBox("Please open the file you wish to import, and be patient. The macro will take 3-5 minutes to run.", _
vbOKOnly, "Navigate") = 1 Then
FileToOpen = Application.GetOpenFilename("Text Files (*.csv),*.csv")
FileToOpen = Shell("Notepad.exe " & FileToOpen, 1)
End If
To answer your question, you could use SendKeys(sendkeys is unsound if no wait time is used, or other applications interfere):
Dim ws As Worksheet
Set ws = ThisWorkbook.Worksheets("ReadText") 'whatever your worksheet is
'your code here
FileToOpen = Shell("Notepad.exe " & FileToOpen, 1)
waitTime (2000) 'as an alternative
AppActivate FileToOpen, False
Application.SendKeys "^a", True 'sends select all command keys
waitTime (500)
Application.SendKeys "^c", True 'sends copy keys
waitTime (500)
ws.Activate
ws.Paste Range("A1")
' rest of code
Public Function waitTime(ms As Long)
Application.Wait Now() + (ms / 24 / 60 / 60 / 1000)
End Function
These are untested, but I found some ideas here:
Try adjusting this:
Sub ImportText()
Dim Text
Dim i As Long
Application.ScreenUpdating = False
'put your own path below
Open ActiveWorkbook.Path & "\MYFILE.txt" For Input As #1
i = 1
Do While Not EOF(1) ' Loop until end of file.
Input #1, Text
Range("a" & i) = Text
i = i + 1
Loop
Close #1
End Sub
(this has also been on SO before)
Or
Dim myPlace as Range
Set myPlace = Cells(1,1)
Workbooks.OpenText Filename:=ActiveWorkbook.Path & "\MYFILE.txt", DataType:=xlDelimited, Tab:=True
ActiveSheet.UsedRange.Copy Destination:=myPlace
ActiveWorkbook.Close
I don't know if the second will work, as it just imports as delimited, and as you noted above, doesn't look pretty. But I left it in case it does work for some reason.
My goal is to write a VBA macros that will allow:
to choose a folder with files to open
then to count number of rows in each file (each file contain only 1 sheet).
to move to another folder all the files that contain more than 1 row
I'm very new in VBA, so what i found is how to count number of rows from active worksheet, but i still can't manage automatically files opening and moving to another folder:
Sub RowCount()
Dim iAreaCount As Integer
Dim i As Integer
Worksheets("Sheet1").Activate
iAreaCount = Selection.Areas.Count
If iAreaCount <= 1 Then
MsgBox "The selection contains " & Selection.Rows.Count & " rows."
Else
For i = 1 To iAreaCount
MsgBox "Area " & i & " of the selection contains " & _
Selection.Areas(i).Rows.Count & " rows."
Next i
End If
End Sub
Could someone help with this, please?
This is actually easy. Really easy. :)
First, code to choose a folder to look into for Excel files. Used Google and searched for excel vba select folder dialog. First result yields this code:
Function GetFolder(strPath As String) As String
Dim fldr As FileDialog
Dim sItem As String
Set fldr = Application.FileDialog(msoFileDialogFolderPicker)
With fldr
.Title = "Select a Folder"
.AllowMultiSelect = False
.InitialFileName = strPath
If .Show <> -1 Then GoTo NextCode
sItem = .SelectedItems(1)
End With
NextCode:
GetFolder = sItem
Set fldr = Nothing
End Function
We'll get to using it for later. Next, we need a loop to count how many rows there are in each file/sheet. However, we can't count them without these files open. So, let's look for a code that opens workbooks in a loop. Googling excel vba open excel files in folder, we get the second result. First result is a deprecated method in Excel 2007 and up. I will be assuming you're running 2007 and up. Here's the code, applying the proper correction detailed by Siddharth Rout.
Sub OpenFiles()
Dim MyFolder As String
Dim MyFile As String
MyFolder = "Blah blah blah"
MyFile = Dir(MyFolder & "\*.xlsx")
Do While MyFile <> ""
Workbooks.Open Filename:=MyFolder & "\" & MyFile
MyFile = Dir
Loop
End Sub
Now, some semi-advanced best practices. Rather than opening each workbook/worksheet/file and counting the rows in each of the opened files (which is highly counter-intuitive), let's modify the above code to count the rows in each file as well, then move them to another folder if they have more than one (1) used row. We'll also change the above code to take into consideration as well the first function to get the folder we want to apply the second code to.
Sub OpenFiles()
Dim MyFolder As String
Dim MyFile As String
MyFolder = GetFolder("C:\users\yourname\Desktop" 'Modify as needed.
MyFile = Dir(MyFolder & "\*.xlsx") 'Modify as needed.
Do While MyFile <> ""
Workbooks.Open Filename:=MyFolder & "\" & MyFile
MyFile = Dir
Loop
End Sub
See what happened there? We called the GetFolder function and assigned it to MyFolder. We then concatenate MyFolder and a wildcarded string, then pass it to Dir so we can loop over the files. What's the remaining two things? Right, count the used rows AND moving the files. For the used rows, I'll hack a simple function to check the workbook's only sheet to see if the row is 2 or greater.
Function CountUsedRows(Wbk As Workbook) As Long
Dim WS As Worksheet
Set WS = Wbk.Sheets(1)
CountUsedRows = WS.Range("A" & Rows.Count).End(xlUp).Row 'Modify as necessary.
End Function
Now that's simple enough. Next, let's write a simple code to move the files. For personal purposes, I'll write a code to copy instead. It'll be up to you to modify it for moving, as that's a rather sensitive operation and if it messes up... well. Hmm. But something here tells me that there's a much better option. Copying can cause all manners of error from permission denial to erroneous copying. Since we've got the file open, why not just save them instead to the new folder?
Now, let's tie them all together neatly.
Sub OpenFiles()
Dim MyFolder As String
Dim MyFile As String
Dim TargetWB As Workbook
MyFolder = GetFolder("C:\Users\yourname\Desktop") 'Modify as needed.
MyFile = Dir(MyFolder & "\*.xlsx") 'Modify as needed.
Application.ScreenUpdating = False
Application.DisplayAlerts = False
Do While MyFile <> ""
Set TargetWB = Workbooks.Open(Filename:=MyFolder & "\" & MyFile)
With TargetWB
If CountUsedRows(TargetWB) > 1 Then
.SaveAs "C:\Users\yourname\Desktop\Blah\CopyOf" & MyFile 'Modify as needed.
End If
.Close
End With
MyFile = Dir
Loop
Shell "explorer.exe C:\Users\yourname\Desktop\Blah", vbMaximizedFocus 'Open the folder.
Application.DisplayAlerts = True
Application.ScreenUpdating = True
End Sub
Function GetFolder(strPath As String) As String
Dim fldr As FileDialog
Dim sItem As String
Set fldr = Application.FileDialog(msoFileDialogFolderPicker)
With fldr
.Title = "Select a Folder"
.AllowMultiSelect = False
.InitialFileName = strPath
If .Show <> -1 Then GoTo NextCode
sItem = .SelectedItems(1)
End With
NextCode:
GetFolder = sItem
Set fldr = Nothing
End Function
Function CountUsedRows(Wbk As Workbook) As Long
Dim WS As Worksheet
Set WS = Wbk.Sheets(1)
CountUsedRows = WS.Range("A" & Rows.Count).End(xlUp).Row 'Modify as necessary.
End Function
Tried and tested. Let us know if this works for you.
Nice answer from Manhattan: that's exactly how I use Excel's built-in functionality to select a folder and fetch a set of file names.
However, there's an interesting side-question in there:
Are those single-sheet Excel files workbooks, of just .csv text files?
If they have a .csv extension, you don't need to open them in Excel to count the rows!
Here's the code to do it:
Fast VBA for Counting Rows in a CSV file
Public Function FileRowCount(FilePath As String, Optional RowDelimiter As String = vbCr) As Long
' Returns the row count of a text file, including the header row
' Returns - 1 on error
' Unicode-compliant, works on UTF-8, UTF-16, ASCII, with or without a Byte order Marker.
' Reads a typical 30Mb file over the network in 200-300ms. Hint: always copy to a local folder.
' If you're scanning files for use with a SQL driver, use basSQL.TableRowCount: it's 20x slower,
' but it returns a proper test of the file's usability as a SQL 'table'
' Nigel Heffernan Excellerando.Blogspot.com 2015
' Unit test:
' s=Timer : for i = 0 to 99 : n=FileRowCount("C:\Temp\MyFile.csv") : Next i : Print Format(n,"#,##0") & " rows in " & FORMAT((Timer-s)/i,"0.000") & " sec"
' Network performance on a good day: reads ~ 150 MB/second, plus an overhead of 70 ms for each file
' Local-drive performance: ~ 4.5 GB/second, plus an overhead of 4 ms for each file
On Error Resume Next
Dim hndFile As Long
Dim lngRowCount As Long
Dim lngOffset As Long
Dim lngFileLen As Long
Const CHUNK_SIZE As Long = 8192
Dim strChunk As String * CHUNK_SIZE
If Len(Dir(FilePath, vbNormal)) < 1 Then
FileRowCount = -1
Exit Function
End If
' trap the error of a folder path without a filename:
If FileName(FilePath) = "" Then
FileRowCount = -1
Exit Function
End If
hndFile = FreeFile
Open FilePath For Binary Access Read Shared As #hndFile
lngFileLen = LOF(hndFile)
lngOffset = 1
Do Until EOF(hndFile)
Get #hndFile, , strChunk
FileRowCount = FileRowCount + UBound(Split(strChunk, RowDelimiter))
Loop
Close #hndFile
Erase arrBytes
End Function
Public Function FileName(Path As String) As String
' Strip the folder and path from a file's path string, leaving only the file name
' This does not check for the existence or accessibility of the file:
' all we're doing here is string-handling
' Nigel Heffernan Excellerando.Blogspot.com 2011
Dim strPath As String
Dim arrPath() As String
Const BACKSLASH As String * 1 = "\"
strPath = Trim(Path)
If strPath = "" Then Exit Function
If Right$(strPath, 1) = BACKSLASH Then Exit Function
arrPath = Split(strPath, BACKSLASH)
If UBound(arrPath) = 0 Then ' does not contain "\"
FileName = Path
Else
FileName = arrPath(UBound(arrPath))
End If
Erase arrPath
End Function
Note the use of the Split function to count the row separators: VBA's string-handling is generally slow, especially when you concatenate strings, but there are a couple of places where VBA can perform a string manipulation without internal allocation and deallocation; if you know where they are, you'll find that parts of your code run as fast as a 'C' developer's best work.
Warning: Horrible Hack
Strictly speaking, I should declare Dim arrBytes(CHUNK_SIZE) As Byte and use this Byte array instead of strChunk to receive the Get from a file opened for binary read.
There are two reasons for not doing it the 'right' way:The last Get, which will set end-of-file TRUE, will extract less data from the file than the full 'chunk'. What happens next is that these last few bytes of the file are written into the array without clearing out the data from the previous 'Get'. So you have to do additional plumbing, counting bytes off against LOF(#hwndFile) to detect the 'Last Get' and branching into a statement that clears the buffer, or allocates a smaller byte array and uses that instead;The code will only cope with UTF-8 2-byte encoded character sets, or with single-byte encoded ASCII 'Latin' text if you do a bit of byte-array substitution around your row delimiters.The VBA String type is a byte array with a wrapper that allows your code (or rather, the compiler) to handle all that complexity in the background.
However, it's much faster to go back into the primordial C, using old-school Get statements, than using later libraries like Scripting.FileSystemObject. Also, you have some ability to examine the incoming data at the byte level, to debug issues where you're getting '???????' characters instead of the text you were expecting.
Anyway: this is late to the game, as StackOverflow answers go, and it's an answer to the less-interesting part of your question. But it's going to be interesting to people who need a quick rowcount in their data files, and your question comes at the top of the list when they search for that.
I am a total dummy as for vb and excel, have tried to combine 2 macros that I have found around here, into 1, but obviously did something terribly wrong and now i'm stuck.. First I just used this macro (saved it in as personal.xlsb so as to be able to use it in any workbook)
Sub CSVFile()
Dim SrcRg As Range
Dim CurrRow As Range
Dim CurrCell As Range
Dim CurrTextStr As String
Dim ListSep As String
Dim FName As Variant
FName = Application.GetSaveAsFilename("", "CSV File (*.csv), *.csv")
ListSep = ";"
If Selection.Cells.Count > 1 Then
Set SrcRg = Selection
Else
Set SrcRg = ActiveSheet.UsedRange
End If
Open FName For Output As #1
For Each CurrRow In SrcRg.Rows
CurrTextStr = ìî
For Each CurrCell In CurrRow.Cells
CurrTextStr = CurrTextStr & """" & GetUTF8String(CurrCell.Value) & """" & ListSep
Next
While Right(CurrTextStr, 1) = ListSep
CurrTextStr = Left(CurrTextStr, Len(CurrTextStr) - 1)
Wend
Print #1, CurrTextStr
Next
Close #1
End Sub
That plus the GetUTF8String function code. Now that was working fine. Then I have thought well why not just experiment with my limited (that is a serious understatement) vb understanding, added the following code and changed the CSVFile sub into a function, which I then called from the sub below, with the output file name as a parameter (to be used instead FName = Application.GetSaveAsFilename). I thought yeah, this code saves all sheets automatically, now let's just make sure that the encoding and delimiter/enclosure setting function runs before each sheet is saved. It doesn't seem right but I thought hey why not try..
Public Sub SaveAllSheetsAsCSV()
On Error GoTo Heaven
' each sheet reference
Dim Sheet As Worksheet
' path to output to
Dim OutputPath As String
' name of each csv
Dim OutputFile As String
Application.ScreenUpdating = False
Application.DisplayAlerts = False
Application.EnableEvents = False
' Save the file in current director
OutputPath = ThisWorkbook.Path
If OutputPath <> "" Then
Application.Calculation = xlCalculationManual
' save for each sheet
For Each Sheet In Sheets
OutputFile = OutputPath & Application.PathSeparator & Sheet.Name & ".csv"
' make a copy to create a new book with this sheet
' otherwise you will always only get the first sheet
Sheet.Copy
' this copy will now become active
CSVFile(OutputFile)
ActiveWorkbook.SaveAs Filename:=OutputFile, FileFormat:=xlCSV, CreateBackup:=False
ActiveWorkbook.Close
Next
Application.Calculation = xlCalculationAutomatic
End If
Finally:
Application.ScreenUpdating = True
Application.DisplayAlerts = True
Application.EnableEvents = True
Exit Sub
Heaven:
MsgBox "Couldn't save all sheets to CSV." & vbCrLf & _
"Source: " & Err.Source & " " & vbCrLf & _
"Number: " & Err.Number & " " & vbCrLf & _
"Description: " & Err.Description & " " & vbCrLf
GoTo Finally
End Sub
Saved that and with that I have managed to achieve something very different. On opening any workbooks, that macro runs and opens up my sheets from that particular workbook as csv files (without saving them). Now I am like Alice in Wonderland. How come it is running on file open? That is not desirable, so I went back to the macro code and changed it back to just the csvfile sub. Well that didn't help, no idea what I did there, was definitely editing the same macro... So I deleted the macro, the modul, I cannot imagine where the thing now is but it's still running + I get this warning that macros were deactivated. Can't get rid of it! Now lads, I'm sorry for the total lack of professionality from my side, this was just supposed to be a small favor for a client, without wasting loads of time learning vb, coz my boss doesn't like that... I am of course interested in how to achieve the goal of saving the sheets automatically after setting the deimiter and enclosure in them. And at this moment I am very interested in how to get rid of that macro and where it is hiding.. What have I done?! Thank you for your patience!
I think the problem lies with the line
OutputPath = ThisWorkbook.Path
Because you are running this from your personal.xlsb which is stored in your XLSTART folder it has created the CSV files in the same location. When Excel starts it will try and load any files that it finds in that location.
Just locate your XLSTART folder and delete any CSV files you find there.
Try using
OutputPath = ActiveWorkbook.Path
XLSTART folder location, dependent on your system, is probably something like:
C:\Users\YOURNAME\AppData\Roaming\Microsoft\Excel\XLSTART