Solved: Save range to a text file

[Marcster]

Hi people,
Sorry if there is already an answer to this. I've looked, but
couldn't quite find what I'm after.

I'm trying to write a procedure to save the active worksheet
to a text file without saving the contents of columns A and B in it.
So far I have:

Sub SaveAsTextFile()
Dim LastRow As Long
Dim rng As Range
LastRow = Range("C65536").End(xlUp).Row
Set rng = Range("C1:G" & LastRow)
 
rng.Select
ActiveWorkbook.SaveAs "C:\" & Format(Date, "ddmmyy"), xlTextMSDOS
MsgBox "File Saved" 
End Sub

But it saves the whole contents of the worksheet.
What I want it to do is save the contents of the worksheet without
the contents of columns A and B.
Is there a procedure to save the selected range?.

Thanks,

Marcster.

[lucas]

Hi Marcster,
Haven't worked this out for you yet but I think I have a clue for you.
This line saves the entrire workbook as comma delemited file. so no matter what you have done before that line.....

ActiveWorkbook.SaveAs "C:\" & Format(Date, "ddmmyy"), xlTextMSDOS

I think you need to select your range and then save it as a temp file, then run the line above and close the temp file.
Hope this helps and I will try to look at this later if I can make time.

[TheAntiGates]

You probably already know that you can print selection (or perhaps print directly from a range via .printout). You want something like Range ("foo").export. I can't find one, so I agree w/ Lucas - use Workbooks.Add.

Here's an interesting article, but probably not the carrot for your immediate pursuit:
"How to send a range of cells in an e-mail message by using Visual Basic for Applications in Excel 2002 or Excel 2003"
http://support.microsoft.com/?kbid=816644

[lucas]

Hi Marcster,

I think I have a working solution for you...maybe someone can improve on it but this works.....copies the workbook first then removes what you don't want, then saves it.

EDIT: you will have to change the path to save the file in the the code and the example. I don't have a C drive so I forgot to change it back.

Option Explicit
Sub SaveAsTextFile()
Application.ScreenUpdating = False
ActiveSheet.Copy
Dim LastRow As Long
Dim rng As Range
LastRow = Range("A65536").End(xlUp).Row
Set rng = Range("A1:A" & LastRow)
rng.Offset(0, 0).ClearContents
rng.Offset(0, 1).ClearContents
ActiveWorkbook.SaveAs "F:\Temp\" & Format(Date, "ddmmyy"), xlTextMSDOS
ActiveWorkbook.Close True
MsgBox "File Saved"
Application.ScreenUpdating = True
End Sub

attached a simple example

[lucas]

Forgot to clean up at the end of the routine:
please add this to the end of the routine:

Set rng = Nothing 

Option Explicit 
Sub SaveAsTextFile() 
Application.ScreenUpdating = False 
ActiveSheet.Copy 
Dim LastRow As Long 
Dim rng As Range 
LastRow = Range("A65536").End(xlUp).Row 
Set rng = Range("A1:A" & LastRow) 
 
rng.Offset(0, 0).ClearContents 
rng.Offset(0, 1).ClearContents 
 
ActiveWorkbook.SaveAs "F:\Temp\" & Format(Date, "ddmmyy"), xlTextMSDOS 
ActiveWorkbook.Close True 
 
MsgBox "File Saved" 
Application.ScreenUpdating = True 
Set rng = Nothing 'add this line please
End Sub

[Marcster]

Thanks lucas,
In column C I have formula's which are based on the contents of
column A and B.
When I run SaveAsTextFile the output doesn't display the contents
of column C.
I have already tried hiding columns A and B but this doesn't work either.
Any ideas?.

Hi TheAntigates,
Interesting article you have given the link for.
I do know about the print selection and have tried setting
the print area by VBA. Still outputs the whole worksheet though.

I guess what I'm after is a range.saveas function.

I'm using Excel 2000.

Thanks,

Marcster.

[mvidas]

Heres another way that just accesses the data and file directly, should do exactly what you need:

Sub SaveAsTextFile()
 Dim URange As Range, URArr(), i As Long, j As Long, vFF As Long, ExpArr() As String
 Set URange = Intersect(ActiveSheet.UsedRange, Columns("C:IV"))
 If URange Is Nothing Then Exit Sub
 URArr = URange.Value
 ReDim ExpArr(1 To UBound(URArr, 1))
 For i = 1 To UBound(URArr, 1)
  For j = 1 To UBound(URArr, 2) - 1
   ExpArr(i) = ExpArr(i) & URArr(i, j) & Chr$(9)
  Next 'j
  ExpArr(i) = ExpArr(i) & URArr(i, UBound(URArr, 2))
 Next 'i
 vFF = FreeFile
 Open "C:\" & Format(Date, "ddmmyy") & ".txt" For Output As #vFF
 For i = 1 To UBound(ExpArr)
  Print #vFF, ExpArr(i)
 Next 'i
 Close #vFF
 Set URange = Nothing
 MsgBox "File Saved"
End Sub

Matt

[lucas]

This will give you a comma delimited textfile. Dont forget to change the path.

Option Explicit
Sub SaveAsTextFile()
Application.ScreenUpdating = False
ActiveSheet.Copy
    Dim LastRow As Long
    Dim rng As Range
    LastRow = Range("A65536").End(xlUp).Row
    Set rng = Range("A1:A" & LastRow)
rng.Offset(0, 0).ClearContents
    rng.Offset(0, 1).ClearContents
ActiveWorkbook.SaveAs Filename:= _
    "F:\Temp\" & Format(Date, "ddmmyy") & ".txt", FileFormat:=xlCSVMSDOS, _
    CreateBackup:=False
    Application.Run "checkname"
    ActiveWorkbook.Close True
MsgBox "File Saved"
    Application.ScreenUpdating = True
Set rng = Nothing
End Sub

[lucas]

Great solution Matt. Glad you came along to help.

[mvidas]

Great solution Matt. Glad you came along to help.

I don't usually look at questions that already have some replies to it, but for some reason I clicked on this one.
The only downfall to this might be if some of the columns being exported contain specific numberformats, as this just takes the underlying values. Of course it can be changed if need be.

You could also have a function for this:

Sub AnExample()
 If ExportRange(Intersect(ActiveSheet.UsedRange, Columns("C:IV")), "C:\" & _
  Format(Date, "ddmmyy") & ".txt", Chr$(9)) Then MsgBox "File Saved"
End Sub
Function ExportRange(ByVal TheRange As Range, ByVal TheFile As String, Optional ByVal _
  vDelimiter As String = ",") As Boolean
 Dim URArr(), i As Long, j As Long, vFF As Long, ExpArr() As String
 On Error GoTo QuitFunc
 URArr = TheRange.Value
 ReDim ExpArr(1 To UBound(URArr, 1))
 For i = 1 To UBound(URArr, 1)
  For j = 1 To UBound(URArr, 2) - 1
   ExpArr(i) = ExpArr(i) & URArr(i, j) & vDelimiter
  Next 'j
  ExpArr(i) = ExpArr(i) & URArr(i, UBound(URArr, 2))
 Next 'i
 vFF = FreeFile
 Open TheFile For Output As #vFF
 For i = 1 To UBound(ExpArr)
  Print #vFF, ExpArr(i)
 Next 'i
 Close #vFF
 ExportRange = True
 Exit Function
QuitFunc:
End Function

[Marcster]

Thanks lucas and mvidas great stuff.

I'll try it out...

Thanks,

Marcster.

[lucas]

Hi Marcster,
Glad you found some help. We're both glad Matt came along.
Marcster, if you found your solution could you mark your thread solved please?

[Cyberdude]

I don't know much about writing files from Excel, but can you hide rows or columns and thereby prevent them from being written??

[ho_gh_m]

I want to save a separate text file on the desktop with one click from the range of each column.
This code only stores the columns without the range in one file, but I need the range of each column to be stored in a separate text file.
Please Help
Thank you

I don't usually look at questions that already have some replies to it, but for some reason I clicked on this one.
The only downfall to this might be if some of the columns being exported contain specific numberformats, as this just takes the underlying values. Of course it can be changed if need be.

You could also have a function for this:

Sub AnExample()
 If ExportRange(Intersect(ActiveSheet.UsedRange, Columns("C:IV")), "C:" & _
  Format(Date, "ddmmyy") & ".txt", Chr$(9)) Then MsgBox "File Saved"
End Sub

Function ExportRange(ByVal TheRange As Range, ByVal TheFile As String, Optional ByVal _
  vDelimiter As String = ",") As Boolean
 Dim URArr(), i As Long, j As Long, vFF As Long, ExpArr() As String
 On Error GoTo QuitFunc
 URArr = TheRange.Value
 ReDim ExpArr(1 To UBound(URArr, 1))
 For i = 1 To UBound(URArr, 1)
  For j = 1 To UBound(URArr, 2) - 1
   ExpArr(i) = ExpArr(i) & URArr(i, j) & vDelimiter
  Next 'j
  ExpArr(i) = ExpArr(i) & URArr(i, UBound(URArr, 2))
 Next 'i
 vFF = FreeFile
 Open TheFile For Output As #vFF
 For i = 1 To UBound(ExpArr)
  Print #vFF, ExpArr(i)
 Next 'i
 Close #vFF
 ExportRange = True
 Exit Function
QuitFunc:
End Function