Print to txt file

[luma64]

In my code I write some text from sheet od xls. After write last row is written 1 empty row too.
This is a code with writing:

If Len(osc) > 0 Then
tLine = nove_osc + ";" + stlp_b
Print #f1, tLine
k = k + 1
End If

[SamT]

Luma64,

Welcome to the best VBA help forum on the internet.

that is really not enough information.

What is the problem?

Please post the entire sub.
First click the # Icon in the editor tool bar, then paste a copy of the sub between the Code Tags.

[luma64]

I read xls and depend on lenght of value of cells:
- I create new value
- Write it to txt
- Close file txt



'After click in form this is start

Private Sub cmdOtvorSubor_Click()

cesta = ActiveWorkbook.Path

vstup_xls = Application _
.GetOpenFilename("Input file for aplic DORA(*.xls), *.csv")
If vstup_xls <> False Then
MsgBox "Open file: " & vstup_xls, vbDefaultButton4, " Data pre aplic "
Else
MsgBox "Didn't choose", vbCritical, " Data pre aplic "
Exit Sub
End If


workbookname = vstup_xls
Workbooks.Open vstup_xls

vystup_csv = ActiveWorkbook.Name
vystup_csv = Replace(vystup_csv, ".xls", "")
vystup_csv = vystup_csv + ".csv"

'find last row
Sheets(1).Activate
Call findlastrow(Sheets(1).Name, lastrow)


'write to txt
TargetFile = "tmp.txt"
Dim f1 As Integer
f1 = FreeFile
Open TargetFile For Output As f1

For k = 1 To lastrow
k = 1
hodnota = Cells(k, 1) 'row number

osc = Trim(Cells(k, 1))
stlp_b = Trim(Cells(k, 2))

If Len(osc) = 3 Then
nove_osc = "00" + osc
End If

If Len(osc) = 4 Then
nove_osc = "0" + osc
End If


If Len(osc) = 5 Then
nove_osc = osc
End If

If Len(osc) > 0 Then
tLine = nove_osc + ";" + stlp_b
Print #f1, tLine
k = k + 1
End If

Close f1

final = cesta + "\" + vystup_csv
If Len(Dir$(final)) Then
Kill final
End If


Name TargetFile As cesta + "\" + vystup_csv

MsgBox "END , output file: " + cesta + "\" + vystup_csv, vbInformation
End Sub


Public Function findlastrow(zosit, lastrow)
Sheets(zosit).Activate
If WorksheetFunction.CountA(Cells) > 0 Then

lastrow = Cells.Find(What:="*", After:=[A1], _
SearchOrder:=xlByRows, _
SearchDirection:=xlPrevious).Row

End If


End Function




and after write last row from xls is write to txt empty row

[SamT]

I am not sure, but try this. If you need more help, let us know what, where,how and any errors and what line has the error..

Option Explicit

Private Sub cmdOtvorSubor_Click()

cesta = ActiveWorkbook.Path

vstup_xls = Application _
.GetOpenFilename("Input file for aplic DORA(*.xls), *.csv")
If vstup_xls <> False Then
MsgBox "Open file: " & vstup_xls, vbDefaultButton4, " Data pre aplic "
Else
MsgBox "Didn't choose", vbCritical, " Data pre aplic "
Exit Sub
End If


workbookname = vstup_xls
Workbooks.Open vstup_xls

vystup_csv = ActiveWorkbook.Name
vystup_csv = Replace(vystup_csv, ".xls", ".csv")


'write to txt
TargetFile = vystup_csv
Dim f1 As Integer
f1 = FreeFile
Open TargetFile For Output As f1

With Sheets(1)
With ActiveSheet
If .Cells(1, 1) = "" Then GoTo noData 'Skip all the rest

'find last row
lastrow = .Cells(Rows.Count, 1).End(xlUp).Row
For k = 1 To lastrow
'k = 1 'Never reset the loop counter inside a loop
'hodnota = Cells(k, 1) 'Not used in this code

osc = Trim(Cells(k, 1))
stlp_b = Trim(Cells(k, 2))

Select Case Len(osc)
'Can you guarantee there will never be a Len = 1 or 2?
Case 3: nove_osc = "00" + osc
Case 4: nove_osc = "0" + osc
Case 5: nove_osc = osc
End Select

tLine = nove_osc + ";" + stlp_b
Print #f1, tLine & vbcrlf
Next k
noData:
Close f1
final = cesta + "\" + vystup_csv
If Len(Dir$(final)) Then 'If Len(Dir(final)) = ? 'Yes, I know, but what about the next person?
Kill final
End If

MsgBox "END , output file: " + cesta + "\" + vystup_csv, vbInformation
End Sub

[luma64]

And where write End With ?

[SamT]

After NoData:

It is 4AM here. good night.

[luma64]

sweet dreams. thanks.

[snb]

That's a complicated way to perform a simple task


Sub M_snb()
c00 = Application.GetOpenFilename("Input file for aplic DORA(*.xls), *.csv")

with createobject("scripting.filesystemobject")
sn=split("00" & replace(.opentextfile(c00).readall,vbcrlf,vbcrlf & "00"),vbcrlf)

for j=0 to ubound(sn)-1
sp=split(sn(j),";")
sp(0)=right(sp(0),5)
sn(j)=join(sp,";")
next

.createtextfile(replace(replace(c00,".xls",""),".csv","") & ".csv").write join(sn,vbcrlf)
end with
end sub

[luma64]

Thanks, but macro has to be in vba code (Office 2003)

[snb]

Please consult your VBA handbook.

[GTO]

Thanks, but macro has to be in vba code (Office 2003)


Please consult your VBA handbook.

Deserved if deserved. Kudos snb! LMAO!