Solved: Create Multiple Text Files From Cells & Save As Name In Adjacent Cell

[BeenJammin]

I have two columns one of which has filenames and the other having values. I need help creating a macro that takes each value from a cell outputs it into a text file and then saves it with the filename of the cell next to the value. I'll need it to go down the columns and create separate text files for each. These files would be html files. And it would be like say I have one column with cat, dog, cow. The column next to it would have cat.html, dog.html, cow.html. The first column would make up all the text within the text file and the second would be the file name. So after the macros are done I would open up cat.html and find it only having the word cat within it and so forth.

[mdmackillop]

Something like this
[VBA]
Sub Makro1()
Dim Pth As String, SaveName As String, Cel As Range
Pth = "E:\"

For Each Cel In Selection
SaveName = Cel.Offset(, 1) & ".html"
Cel.Copy
Workbooks.Add
ActiveSheet.Paste
ActiveWorkbook.SaveAs Filename:=Pth & SaveName, FileFormat:=xlHtml
ActiveWorkbook.Close False
Next
End Sub

[/VBA]

[BeenJammin]

Thanks alot it works.

[lucas]

Hi Been, be sure to mark your thread solved using the thread tools at the top of the page.

[Dr.K]

Why would you use Workbook Objects and not Text Streams from the File System Object?

Isn't the latter much faster, even with late binding?

[mdmackillop]

Hi Dr K,
If you have a solution with that method please post it.
Regards
MD

[Dr.K]

Sorry for the delay, but I only recently found the reply email.

Ok, the first problem I have with your code, is that it translates the single text string into full Office XML, when what the original poster asked for was:

The first column would make up all the text within the text file

My solution does exactly that, and its MUCH faster. Elapsed time in seconds for 10 iterations of each:
Makro1: 7.484375
Macro2: 0.0625

If you turn the screen updating off, it helps the first one a little:
Makro1: 6.3125
Macro2: 0.0625

Here is my code: (the FSO is Late-Bound, so no reference is required)

[vba]Sub Macro2()
Dim strPath As String
Dim objCell As Range
Dim FS As Object
Dim TS As Object

strPath = "C:\test\"
Set FS = CreateObject("Scripting.FileSystemObject")


For Each objCell In Selection
Set TS = FS.CreateTextFile(strPath _
& objCell.Offset(0, 1).Value & ".html", True)
TS.writeline objCell.Value
TS.Close
Next objCell

Set TS = Nothing
Set FS = Nothing


End Sub[/vba]


Note that changing the FileFormat code in Makro1 from "xlHtml" to "xlTextWindows" produces the desired output, but does not increase the speed of the macro execution.

[mdmackillop]

Thanks for that. A much better solution.