Excel VBA extra Newline getting inserted through print statement - excel

Through a Excel VBA macro, I'm trying to print up to 10 space seperated arguments for a selected range in excel.
For example, I have the 24 values in my selection range A1:A24 - (say Val1, Val2, Val3, Val4, etc.)
Using the following VBA code, I want to get the output in the "outfile.bat" as
"C:\Program Files (x86)\Google\Chrome\Application\chrome.exe" Val1 Val2.... Val10
"C:\Program Files (x86)\Google\Chrome\Application\chrome.exe" Val11 Val2.... Val20
"C:\Program Files (x86)\Google\Chrome\Application\chrome.exe" Val21 Val22 Val23 Val24
i.e. each line should get printed with maximum of 10 argument values (seperated by a space). Anything above that should be moved to next line (again max of 10 space seperated arguments)
Somehow, the following code is
(1) NOT keeping the output to the same line and
(2) Inserts a newline at the 10th value, but not at the 20th, 30th and other values.
It produces the following:
"C:\Program Files (x86)\Google\Chrome\Application\chrome.exe"
Val1
"C:\Program Files (x86)\Google\Chrome\Application\chrome.exe"
Val2
C:\Program Files (x86)\Google\Chrome\Application\chrome.exe"
Val3
and so on....
Here is my code:
Private Sub GetChromeFile_Click()
Dim myFile As String, rng As Range, cellValue As Variant, i As Integer, j As Integer, a As Integer
myFile = "C:\Users\User1\" & "outfile.bat"
Set rng = Selection
Open myFile For Output As #7
a = 0
For i = 1 To rng.Rows.Count
Print #7, Chr(34) & "C:\Program Files (x86)\Google\Chrome\Application\chrome.exe" & Chr(34)
a = a + 1
cellValue = rng.Cells(i).Value
If (a = 10) Then
Print #7, " " & cellValue & vbNewLine
Else
Print #7, " " & cellValue
End If
Next i
Close #7
Range("F5").Value = " Done!"
End Sub
Please let me know where this may be going wrong.
Thanks

The print statement prints a line to the file, so adding vbNewLine at the end of each is redundant. You're also making calls to Print for each argument value (cellValue in your code), which is why those are appearing on their own line.
You can most likely construct the entire file contents as a single string, and then use a single Print statement to write the whole file. If you're dealing with an enormous amount of data, you may need to segment it but for most cases this should work:
Option Explicit
Sub writebat()
Const pathTxt$ = """C:\Program Files (x86)\Google\Chrome\Application\chrome.exe"" "
Dim lineTxt As String
Dim cellValue As String
Dim fname As String
Dim ff As Long
Dim a As Long
Dim i As Long
Dim rng As Range
Set rng = Selection ' Range("A1:A37")
fname = "C:\Users\User1\" & "outfile.bat" ' "C:\debug\output.txt"
ff = FreeFile()
Open fname For Output As #ff
lineTxt = pathTxt
a = 1
For i = 1 To rng.Rows.Count
'## Add the cell value to the string
lineTxt = lineTxt & rng.Cells(i).Value & " "
If a Mod 10 = 0 Then
'## Start a new line with the executable path
lineTxt = lineTxt & vbNewLine & pathTxt
End If
a = a + 1
Next
Print #ff, lineTxt
Close #ff
End Sub
This yields the following output:

Related

How to copy paste tables from many txt files into 1 excelsheet?

Steps I need to do:
Open all necessary files(which are from the same folder) in Excel
For the first file, copy from row 6 to bottom of table. For second and subsequent files, copy from row 7 to bottom of table (Note that each file has different number of table rows). (Reasoning is that rows 1-5 are irrelevant, row 6 has heading, and I only want the heading to appear once in the table)
Paste into main excelsheet, but without overlapping previous rows
Separate main excelsheet by commas (text to column)
Close all files other than main excelsheet
Tried to google the various steps, but each step's code does not work well with one another, resulting in numerous errors, so I gave up and tried to record macro, but I did not get a "for" loop.
I've just tested the code below
Sub Read_Texts()
'Variable Declaration
Dim sFilePath As String
Dim sFileName As String
'Specify File Path
sFilePath = "C:\Users\use\Desktop\New folder"
'Check for back slash
If Right(sFilePath, 1) <> "\" Then
sFilePath = sFilePath & "\"
End If
sFileName = Dir(sFilePath & "*.txt")
Do While Len(sFileName) > 0
If Right(sFileName, 3) = "txt" Then
'Display file name in immediate window
Dim hf As Integer: hf = FreeFile
Dim lines() As String, i As Long
Open sFileName For Input As #hf
lines = Split(Input$(LOF(hf), #hf), vbNewLine)
Close #hf
If sFileName = "file1.txt" Then
For i = 5 To UBound(lines)
Debug.Print "File 1 Line"; i; "="; lines(i)
Next
Else
For i = 6 To UBound(lines)
Debug.Print "File 1 Line"; i; "="; lines(i)
Next
End If
End If
'Set the fileName to the next available file
sFileName = Dir
Loop
End Sub
Change C:\Users\use\Desktop\New folder according to your folder path, and here you can do whatever with the returned lines Debug.Print "File 1 Line"; i; "="; lines(i)

How do I construct the Shell 'path' string in VBA to open notepad++ with a file at a particular line?

I tried a number of ways to construct the string to call notepad++ with a filename.
I need to also utilize the '-n' parameter for notepad++ to open a file at a particular line. Simple cases work, however when concatenating strings for the path I have been getting runtime 424 errors.
This is in VBA in Excel.
Option Explicit
Sub GoToLine()
Dim strNotePadPath As String
strNotePadPath = "C:\Program Files\NotePad++\notepad++.exe "
Dim strSourceBasePath As String
strSourceBasePath = "C:\VBAExcelTest\TestSource"
Dim strSourcePathFinal As String
strSourcePathFinal = strSourceBasePath & Cells(Selection.Row, 1).Value
Dim strLineNumber As String
strLineNumber = " -n" & Cells(Selection.Row, 2).Value
Dim retval As Variant
'This works: retval = Shell("C:\Program Files\NotePad++\notepad++.exe C:\VBAExcelTest\TestSource\SourceA\FakeSourceA.txt -n1", 1)
'I get a runtime error 424 on the Call Shell line below
If Selection.Row.Count = 1 Then
Call Shell("""" & strNotePadPath & strSourcePathFinal & strLineNumber & """", vbNormalFocus)
End If
End Sub
Sometimes a token-replacement approach is easier to manage when dealing with escaped quotes etc:
Sub GoToLine()
Dim cmd As String, retval As Variant, rw As Range
Set rw = Selection.Cells(1).EntireRow
cmd = Tokens("""{1}"" ""{2}"" {3}", _
"C:\Program Files\NotePad++\notepad++.exe", _
"C:\Tester\tmp\" & rw.Cells(1).Value, _
"-n" & rw.Cells(2).Value)
Debug.Print cmd
Shell cmd, vbNormalFocus
End Sub
'replace tokens in the first argument, using the rest of the arguments
Function Tokens(txt As String, ParamArray args() As Variant) As String
Dim i As Long, t As Long
t = 0
For i = 0 To UBound(args)
t = t + 1
txt = Replace(txt, "{" & t & "}", args(i))
Next i
Tokens = txt
End Function

Semi colon seperated csv in VBA

I am creating a csv as semi colon seperated, but the file output of csv has a blank line at top.
Please help me what needs to update in my below code
Sub WriteToCSV()
Dim FileNumber As Long
Dim temp As String
Dim cl As Range
Dim rw As Range
FileNumber = FreeFile '
'get a new file number
FileNumber = FreeFile
' change path & file name as required
Open "C:\Users\standard\Desktop\automation\ankur.csv" For Output As #FileNumber
Print #FileNumber, temp
'change the worksheet index by its real position or Name between quotes, eg Worksheets("Sheet1").
For Each rw In Worksheets(1).Range("A1").CurrentRegion.Rows
For Each cl In rw.Cells
temp = temp & cl.Value & ";"
Next cl
Print #FileNumber, temp
're=initialise string
temp = ""
Next rw
Close #FileNumber
End Sub
Your code has Print #FileNumber, temp immediately after opening the file for output. As temp has not been set to anything, it is an empty string, hence the blank line.
Also, you don't need to use FreeFile twice.
Regards,

While exporting/converting to CSV, replace first line with newline

EDIT: I CHANGED THIS ORIGINAL POST SO I COULD EMBED THE FINAL CODE I WENT WITH.
Using the code at the bottom to export a specific worksheet and convert to a CSV file.
The output file will consistently have the very first line beginning with a blank space followed by the string
,,Primary,Secondary,Tertiary
I would like to remove/replace that line with a newline. i.e..
CURRENT:
,,Primary,Secondary,Tertiary
100,106,2165483624,2165483624,8133181331
I would like to remove/replace that top line with a newline. i.e:
(newline here)
100,106,2165483624,2165483624,8133181331
That line will always be the first line, and will be the only line beginning with a space and two commas, also the only one with the words Primary,Secondary,Tertiary comma-delimited.
I've spent several hours checking this site and others but either
I'm using the wrong keywords or my desired outcome hasn't been
documented yet. Thanks in advance.
CODE I ENDED UP USING IS BELOW
Sub btn_Export_to_CSV_Click()
Dim csvFilePath As String
Dim fileNo As Integer
Dim fileName As String
Dim oneLine As String
Dim lastRow, lastCol As Long
Dim idxRow, idxCol As Long
' --- get this file name (without extension)
fileName = Left(ActiveWorkbook.Name, InStrRev(ActiveWorkbook.Name, ".", -1, vbTextCompare) - 1)
' --- create file name of CSV file (with full path)
csvFilePath = ActiveWorkbook.Path & "\" & fileName & ".csv"
' --- get last row and last column
lastRow = Cells(Rows.Count, 1).End(xlUp).Row
lastCol = Cells(1, Columns.Count).End(xlToLeft).Column
' --- open CSC file
fileNo = FreeFile
Open csvFilePath For Output As #fileNo
Print #fileNo, "" ' -- write one blank line
' --- row loop
For idxRow = 2 To lastRow
oneLine = ""
' --- column loop: concatenate oneLine
For idxCol = 1 To lastCol
If (idxCol = 1) Then
oneLine = Cells(idxRow, idxCol).Value
Else
oneLine = oneLine & "," & Cells(idxRow, idxCol).Value
End If
Next
' --- write oneLine > CSV file
Print #fileNo, oneLine ' -- Print: no quotation (output oneLine as it is)
Next
' --- close file
Close #fileNo
MsgBox "CSV file completed !!" & Chr(13) & csvFilePath
End Sub

Reading International/Special Characters in VBA

I read an Excel spreadsheet row by row and for each row create a textfile including information from the columns.
From time to time there is foreign text in some of the spreadsheet cells. In the debugger the foreign text appears as '?' question marks. It fails when trying to write these question marks to the text file.
This is a snippet of the code that reads the values from a row to a string array
Set oFS = CreateObject("Scripting.Filesystemobject")
For Each rID In oSh.UsedRange.Columns("A").Cells
For Each rValue In oSh.UsedRange.Rows(rowCount).Cells
ReDim Preserve columnValues(columnCount)
columnValues(columnCount) = rValue
columnCount = columnCount + 1
Next
Next
This is the code which writes to a text file
sFNText = sMakeFolder & "\" & rID.Value & ".txt"
Set oTxt = oFS.OpenTextFile(sFNText, 2, True)
For i = 0 To UBound(columnTitles)
oTxt.Write columnTitles(i) & ": " & columnValues(i) & vbNewLine
Next i
oTxt.Close
I have experimented with changing the format of opentextfile and also using AscW and ChrW to convert to and from ansi.
EDIT: In particular I am trying to read in Greek symbols (pi, omega etc.) and write them back out to a textfile. I have used the
StrConv(Cells(1, 1), vbUnicode)
method that was detailed in How can I create text files with special characters in their filenames and have got that example working. It seems now a problem with writing this to a textfile. nixda's example seems to work in isolation when using his Print command, however when I try
otxt.Write
to write my stored variable to a textfile it writes out garbage, as opposed to the print method which produces the correct result. Looking at the debugger both variables are stored identically (print method + write), so I believe it is now down to the output method (otxt.Write) which is converting the stored variable into garbage. I have tried using the -1 & -2 options for OpenTextFile - both producing garbage results.
I have the following sheet:
and the following code:
Sub writeUnicodeText()
Dim arr_Strings() As String
i = 0
For Each oCell In ActiveSheet.Range("A1:A4")
ReDim Preserve arr_Strings(i)
arr_Strings(i) = oCell.Value
i = i + 1
Next
Set oFS = CreateObject("Scripting.Filesystemobject")
Set oTxt = oFS.OpenTextFile("C:\users\axel\documents\test.txt", 2, True, -1)
For i = 0 To UBound(arr_Strings)
oTxt.Write arr_Strings(i) & vbNewLine
Next i
oTxt.Close
End Sub
This produces the following file:
This is the code I use to write to a text. I've tried many methods and this has worked the best.
Sub ProcessX()
FName1 = "Location of File"
txtStrngX = OpenTextFileToString2(FName1)
end sub
Public Function OpenTextFileToString2(ByVal strFile As String) As String
Dim hFile As Long
hFile = FreeFile
Open strFile For Input As #hFile
OpenTextFileToString2 = Input$(LOF(hFile), hFile)
Close #hFile
End Function
As for reading in from rows just be sure to set your variable to a string when compiling and any method should work fine.
sorry. That's reading from a text. Here is writing.
Public Function RecordsetToText(rs As Object, Optional FullPath _
As String, Optional ValueDelimiter As String = " ") As Boolean
'PURPOSE: EXPORTS DATA FROM AN ADO RECORDSET TO A TEXT FILE
'PARAMETERS:
'RS: Recordset to Export. Open the recordset before
'passing it to this function
'FullPath (Optional): FullPath of text file.
'if not specified, the function uses app.path +
'rs.txt
'ValueDelmiter (Optional): String to delimiter
'values within a row. If not specified, an tab
'is used
'RETURNS: True if successful, false if an error occurs
'COMMENTS: Rows are delimited by a carriage return
Dim sFullPath As String
Dim sDelimiter As String
Dim iFileNum As Integer
Dim lFieldCount As Long
Dim lCtr As Long
Dim oField As ADODB.Field
On Error GoTo ErrorHandler:
If RecordSetReady(rs) = False Then Exit Function
sDelimiter = ValueDelimiter
If FullPath = "" Then
sFullPath = App.Path
If Right(sFullPath, 1) <> "\" Then sFullPath = _
sFullPath & "\"
sFullPath = sFullPath & "rs.txt"
Else
sFullPath = FullPath
End If
iFileNum = FreeFile
Open sFullPath For Output As #iFileNum
With rs
lFieldCount = .Fields.Count - 1
On Error Resume Next
.MoveFirst
On Error GoTo ErrorHandler
For lCtr = 0 To lFieldCount
Set oField = .Fields(lCtr)
If lCtr < lFieldCount Then
Print #iFileNum, oField.Name & sDelimiter;
Else
Print #iFileNum, oField.Name
End If
Next
Do While Not .EOF
For lCtr = 0 To lFieldCount
Set oField = .Fields(lCtr)
If lCtr < lFieldCount Then
Print #iFileNum, oField.Value & sDelimiter;
Else
Print #iFileNum, oField.Value
End If
Next
.MoveNext
Loop
End With
RecordsetToText = True
ErrorHandler:
On Error Resume Next
Close #iFileNum
End Function

Resources