PDA

View Full Version : Solved: output excel rows to txt files



jramsey
06-26-2012, 08:10 AM
I have been searching around for a script / macro that will create a text file from each row of a work sheet and name it from the first cell of the row.
Each row has 9 cells and I want to create the file from cells B - I (each Cell on a new line of the text file) and name it from cell A. I have many sheets that are formatted the same way with hundreds of rows on them.

The output file should look like this

FILE NAME = Cell A.mtag

cell B
cell C
cell D
cell E
cell F
cell G
cell H
cell I


I am using excel 2003 SP3

Thank you in advanced for any help you guys can provide.

Jason

Tinbendr
06-26-2012, 08:25 AM
Welcome to the board!

A larger sampling of the data would have be nice.

Sub Output2File()

Dim WB As Workbook
Dim WS As Worksheet
Dim LastRow As Long
Dim A As Long
Dim B As Long

Set WB = ActiveWorkbook
Set WS = WB.Worksheets(1)

With WS
LastRow = .Cells(.Rows.Count, 1).End(xlUp).Row

For A = 1 To LastRow
Open .Range("A" & A) & ".mtag" For Output As #1
For B = 2 To 9
Write #1, .Cells(A, B).Value
Next
Close #1
Next
End With

End Sub

snb
06-26-2012, 09:05 AM
or

sub snb()
sn=thisworkbook.sheets(1).cells(1).currentregion

with createobject("scripting.filesystemobject")
for j=1 to ubound(sn)
.createtextfile(sn(j,1) & ".mtag").write join(application.index(sn,j),vbCrLf)
next
end with
End sub

jramsey
06-26-2012, 10:16 AM
Thank you for the fast responses. I tried to set my output path the C:\test\ but I keep getting a syntax error so I am obviously missing something. How much more data are you looking for?

snb
06-26-2012, 11:52 AM
Sub snb()
sn=thisworkbook.sheets(1).cells(1).currentregion

With createobject("scripting.filesystemobject")
For j=1 To UBound(sn)
.createtextfile("C:\Text\" & sn(j,1) & ".mtag").write join(application.index(sn,j),vbCrLf)
Next
End With
End Sub

jramsey
06-26-2012, 12:08 PM
Well i am still getting a runtime error '76':
path not found

jramsey
06-27-2012, 08:13 AM
Tinbendr, I added "c:\text\" & to the open line and I can get it to output the files I need. However it is adding a bunch of quotes (") to the beginning and end of the lines and its adding Additional quotes to the text already in quotes. so the data in cell 2 is: <meta http-equiv="Content-type" content="text/html;charset=UTF-8"> but what it is writing to the file is: "<meta http-equiv=""Content-type"" content=""text/html;charset=UTF-8"">"

Thank you for the help

Jason

Kenneth Hobs
06-27-2012, 08:34 AM
Use Print rather than Write.

jramsey
06-27-2012, 08:41 AM
Kenneth, now i am back to "path not found"

snb
06-27-2012, 09:23 AM
Well I think it's obvious no such path as C:\Text exists:




Sub snb()
if dir("C:\Text",16)="" then mkdir "C:\Text"


sn=thisworkbook.sheets(1).cells(1).currentregion


With createobject("scripting.filesystemobject")
For j=1 To UBound(sn)
.createtextfile("C:\Text\" & sn(j,1) & ".mtag").write join(application.index(sn,j),vbCrLf)
Next
End With
End Sub

jramsey
06-27-2012, 09:29 AM
it did and does. and i still get a path not found with your added lines.

snb
06-27-2012, 09:31 AM
Did you test my suggestion ?

check whether there are any values in sheets(1), adapt teh code to your situation; e.g sheets("data") if that is the name of the sheet that contains the data.
You best post a sample workbook.

jramsey
06-27-2012, 09:51 AM
here is a sample of the file i am working with

jramsey
06-27-2012, 09:56 AM
and here is what i would like to get out as a text file (.mtag) i had to zip it to get it to upload.

Kenneth Hobs
06-27-2012, 10:09 AM
Of course you do need to set a path to store them.

Sub Output2File()
Dim WB As Workbook
Dim WS As Worksheet
Dim LastRow As Long
Dim A As Long
Dim B As Long
Dim fn As Integer
Dim idPath As String

idPath = ThisWorkbook.Path & "\"
Set WB = ActiveWorkbook
Set WS = WB.Worksheets(1)

With WS
LastRow = .Cells(.Rows.Count, 1).End(xlUp).Row

For A = 1 To LastRow
fn = FreeFile
Open idPath & .Range("A" & A) & ".mtag" For Output As #fn
For B = 2 To 9
Print #fn, .Cells(A, B).Value
Next
Close #fn
Next
End With
End Sub

Obviously, snb's code works fine too. Just be sure to change the value of idPath if needed.
Sub snb()
Dim idPath As String, sn As Variant, j As Long

idPath = ThisWorkbook.Path & "\"
If Dir(idPath, vbDirectory) = "" Then MkDir idPath

sn = ThisWorkbook.Sheets(1).Cells(1).CurrentRegion

With CreateObject("scripting.filesystemobject")
For j = 1 To UBound(sn)
.createtextfile(idPath & sn(j, 1) & ".mtag").write Join(Application.Index(sn, j), vbCrLf)
Next j
End With
End Sub

jramsey
06-27-2012, 10:22 AM
well that did it.. THANK YOU!!!!