[Greshter]

Hi,

I'm sure this has been done before and is in other threads but I thought I'd ask. I have a series of rows that I need to export as individual text files i.e. one row would produce one text file. There are 7 columns with the first column being the file name. Columns 2 - 7 would be the input lines in the text file - and ideally there would be one line per column.

I.e. A B C D E F G
A1 0.1 0 0 -0.1 114 116
B1 0.1 0 0 -0.1 114 117
C1 0.1 0 0 -0.1 114 115

First text file would be named "A1" and would have the following text in it:

0.1
0
0
-0.1
114
116

Second file would be "B1" and so on ...

If anybody has some good ideas about this one it would be great to get some feedback.

Thanks,
Mike

[Claus Busch]

Hi Mike,

Am Sun, 15 Nov 2015 23:32:10 -0800 (PST) schrieb Greshter:

I.e. A B C D E F G
A1 0.1 0 0 -0.1 114 116
B1 0.1 0 0 -0.1 114 117
C1 0.1 0 0 -0.1 114 115

First text file would be named "A1" and would have the following text in it:

0.1
0
0
-0.1
114
116

try:

Sub WriteTxtFiles()
Dim LRow As Long, LCol As Long, i As Long, j As Long
Dim varOut() As Variant
Dim myFile As String, strOut As String

'Modify your path
Const myPath = "D:\Test\"

With ActiveSheet
LRow = .Cells(Rows.Count, 1).End(xlUp).Row
For i = 1 To LRow
LCol = .Cells(i, Columns.Count).End(xlToLeft).Column
myFile = myPath & .Cells(i, 1) & ".txt"
For j = 2 To LCol
ReDim Preserve varOut(LCol - 2)
varOut(j - 2) = .Cells(i, j)
Next
strOut = Join(varOut, vbCrLf)
Open myFile For Output As #1
Print #1, strOut
Close #1
Next
End With
End Sub


Regards
Claus B.
--
Vista Ultimate / Windows7
Office 2007 Ultimate / 2010 Professional

[GS[_6_]]

An alternative that implements a reusable routine to write text
files...

Option Explicit

Sub ExportData()
Dim vData, vFilenames, sText$, n&, lNumRows&, lNumCols&
Const sPath$ = "D:\Test\"

'Get the data area
With ActiveSheet
lNumRows = .Cells(.Rows.Count, 1).End(xlUp).Row
lNumCols = .Cells(1, .Columns.Count).End(xlToLeft).Column
vFilenames = .Cells(1, 1).Resize(lNumRows)
vData = .Cells(1, 2).Resize(lNumRows, lNumCols - 1)
End With

'Write the data to file
For n = 1 To lNumRows
WriteTextFile Join(Application.Index(vData, n, 0), vbCrLf), sPath &
vFilenames(n, 1) & ".txt"
Next 'n
End Sub

Sub WriteTextFile(TextOut$, Filename$, _
Optional AppendMode As Boolean = False)
' Reusable procedure that Writes/Overwrites or Appends
' large amounts of data to a Text file in one single step.
' **Does not create a blank line at the end of the file**
Dim iNum%
On Error GoTo ErrHandler
iNum = FreeFile()
If AppendMode Then
Open Filename For Append As #iNum: Print #iNum, vbCrLf & TextOut;
Else
Open Filename For Output As #iNum: Print #iNum, TextOut;
End If

ErrHandler:
Close #iNum: If Err Then Err.Raise Err.Number, , Err.Description
End Sub 'WriteTextFile()

--
Garry

Free usenet access at http://www.eternal-september.org
Classic VB Users Regroup!
comp.lang.basic.visual.misc
microsoft.public.vb.general.discussion