This should work, it will output one line per selected cell cells are numbered left to right and down, so selecting a single column should work.
In Excel 2000 you can have multiple selection ranges
if you have multiple selection ranges each range will
be processed independently in the order that it each was
selected:
i.e. A1:A5, A3:C3, C2:D5
If you do not want to incude cells that are blank or only
include spaces you can include your own test.
IF cell.text <> "" THEN ...
Option Explicit Sub OneRowPerCell() Dim newrange As Range Dim cell As Range Dim filename As Variant Dim retVal As Variant Dim suffix As String suffix = "" ' Range("B:B").Select 'for testing, normally manually select a column/cells Set newrange = Intersect(Selection, ActiveSheet.UsedRange) filename = "c:\temp\myfile.txt" filename = InputBox("Supply filename for HTML generated from " _ & "selected range", "Filename for myfile", filename) If UCase(Right(filename, 4)) = ".HTM" Then suffix = "<br>" Close #1 Open filename For Output As 1 For Each cell In newrange Print #1, cell.Text & suffix Next cell Close #1 '------------------ view results --------------------------. If UCase(Right(filename, 4)) = ".HTM" Then retVal = Shell("C:\Program Files\Internet Explorer" _ & "\IEXPLORE.EXE " & filename, vbNormalFocus) Else retVal = Shell("NOTEPAD.EXE " & filename, vbNormalFocus) End If End Sub
Sub OneRowPerCellPerColumn() Dim newrange As Range Dim cell As Range Dim filename As Variant Dim retVal As Variant Dim suffix As String suffix = "" Dim iCol As Long Dim Col_id As String Dim colRange As Range For iCol = 1 To ActiveSheet.UsedRange.Columns.Count Set newrange = Intersect(Cells.Columns(iCol), ActiveSheet.UsedRange) Col_id = Left(Cells(1, iCol).Address(0, 0), _ Len(Cells(1, iCol).Address(0, 0)) - 1) filename = "c:\temp\myfile_" & Col_id & ".txt" If UCase(Right(filename, 4)) = ".HTM" Then suffix = "<br>" Close #1 'standard practice, close before opening Open filename For Output As 1 For Each cell In newrange 'newrange If Trim(cell.Text) <> "" Then Print #1, cell.Text & suffix End If Next cell Close #1 Next iCol End Sub
'Code to read file until finished Open "c:\temp\outdoor.csv" for input as #1 do while not eof(1) input #1,x loop closeuses the Line Input # statement to read a line from a sequential file and assign it to a variable.
Open "TESTFILE" For Output As #1 ' Open file for output. Write #1, "Hello World", 234 ' Write comma-delimited data. Write #1, ' Write blank line. MyDate = #February 12, 1969# : MyNull = Null Write #1, MyDate ; " is a date" Close #1 ' Close file.
Set fs = CreateObject("Scripting.FileSystemObject") Set a = fs.CreateTextFile("c:\testfile.txt", True) a.WriteLine("This is a test.") a.Close
copy part1.html +passlist.html +part3.html composite.html
Sub ReadCommaSepFile_NoReturns() Dim myVar As Variant Dim i As Long Dim rw As Long 'Open the file for Input Open "C:\Test1.TXT" For Input As #1 'Read each line of the text file into the list of variables 'until the end of the file is reached i = 0 rw = 1 Do While Not (EOF(1)) Input #1, myVar i = i + 1 If i = 4 Then Cells(rw, i).Value = CDate(myVar) Else Cells(rw, i).Value = myVar End If If i = 6 Then rw = rw + 1 i = 0 End If Loop 'Close the file Close 1 End SubFor more information on Importing and Exporting Text files with your own delimiters see Chip Pearson's web pages on export and import.
Sub Macro23() dim retval as variant ActiveWorkbook.SaveAs filename:="C:\temp\text.txt", _ FileFormat:=xlTextPrinter, CreateBackup:=False '--- show results ---- retval = Shell("NOTEPAD.EXE " & _ "c:\temp\text.txt", vbNormalFocus) End Sub
If the filename contains spaces, you will have to include it within double quotes. (start Runs a Windows program or an MS-DOS program.) E.g.,
From DOS: start c:\copiedsite\dmcritchie\excel\excel.htm start "c:\copiedsite\dmcritchie\excel\excel.htm" start http://www.mvps.org/dmcritchie/excel/excel.htm From DOS starting Excel with switches: (291288 - Startup Switches for Microsoft Excel (2002: 291288, 2000: 211481; 97: 159474) (SAFE Mode, Re-register/Reregister Excel extensions) ) Excel.exe /r "C:\test\file.xls" From VBA: Shell "start ""s:\new projects\drawing.dwg"" " Shell "start c:\copiedsite\dmcritchie\excel\excel.htm" Shell "start ""c:\copiedsite\dmcritchie\excel\excel.htm""" also look at GetObject in VBA help. More VBA: Dim pblnHelp As Boolean pblnHelp = Shell("start " & " """ & _ ActiveWorkbook.path & "\help.pdf"" ", vbMaximizedFocus) Worksheet Solution, thanks to Scott Rubin =HYPERLINK("help.pdf","Help and usage information")
Change directory or folder. ChDir Change the drive. ChDrive Copy a file. FileCopy Make directory or folder. MkDir Remove directory or folder. RmDir Rename a file, directory, or folder. Name Return current path. CurDir Return file date/time stamp. FileDateTime Return file, directory, label attributes. GetAttr Return file length. FileLen Return file name or volume label. Dir Set attribute information for a file. SetAttr
Visit [my Excel home page] [Index page] [Excel Onsite Search] [top of this page]
Please send your comments concerning this web page to: David McRitchie send email comments
Copyright © 1997 - 2006, F. David McRitchie, All Rights Reserved