aanhalingstekens bij export naar TXT

emil

2004-11-24 15:37:21 UTC

jean,
uit deze ng een bericht:
<quote>
Van: "Ad" <***@discussions.microsoft.com>
Onderwerp: Wegschrijven naar textbestand
Datum: donderdag 16 september 2004 12:20

Hallo,
Ik heb onderstaande macro om een excelbestand weg te
schrijven naar een textbestand.
Een nadeel: de oude text in het textbestand wordt telkens
overschreven. Graag zou ik willen dat de text toegevoegd
wordt zodat ik geen data kwijt raak.
Weet iemand een oplossing?

Sub NaarTXT() 'schrijft naar textbestand
Dim rng As Range
Dim iRow As Integer, iCol As Integer, iFile As Integer
Dim sFile As String, sTxt As String
Set rng = Range("A1").CurrentRegion

' sFile = Application.Path & "/testtext.txt"
sFile = "T:\Data\excel\testtext.txt"
iFile = FreeFile
Open sFile For Output As iFile
For iRow = 1 To rng.Rows.Count
For iCol = 1 To rng.Columns.Count
sTxt = sTxt & Cells(iRow, iCol).Value & ";"
Next iCol
sTxt = Left(sTxt, Len(sTxt) - 1)
Print #iFile, sTxt
sTxt = ""
Next iRow
Close iFile
rng.ClearContents
MsgBox "De data is in een textdocument ingelezen"
End Sub

Ad,

Gebruik voor de modus i.p.v. Output de modus Append

Open sFile For Append As iFile

dan zou dat moeten lukken

Jan
<unquote>
drie verschillen met jouw code:
- gebruik van print in plaats van write
- lijstscheidingsteken = ;
- de gegevens worden per regel weggeschreven.
--
groet, emil
<getest met office2000>

"Jean-Paul rijnsburger" <***@discussions.microsoft.com> schreef in
bericht news:8efc01c4d22e$1045b970$***@phx.gbl...
Onderstaande sub (rechtstreeks gejat van J-walk) zet text
uit een cel in een TXT file. allemaal prachtig en ik ben
er erg blij mee. Alleen wordt de text vooraf gegaan door
"aanhalingstekens" er staat dus "text" ipv gewoon text.
Iemand een briljant idee voor het voorkomen van
de "aanhalingstekens"
(een niet zo briljant maar werkend idee is natuurlijk ook
welkom)

alvast bedankt

Jean-Paul

Sub export()

Dim ExpRange As Range
Set ExpRange = ActiveCell.CurrentRegion
firstcol = ExpRange.Columns(1).Column
lastcol = ExpRange.Columns(1).Column

firstrow = ExpRange.Rows(1).Row
lastrow = firstrow + ExpRange.Rows.Count - 1

Open ThisWorkbook.Path & "\test.txt" For Output As #1
For r = firstrow To lastrow
For c = firstcol To lastcol
vdata = ExpRange.Cells(r, c).Value
If c <> lastcol Then
Write #1, vdata;
Else: Write #1, vdata
End If
Next c
Next r
Close #1
End Sub