Hi
How can I get a txt file (result003.txt) from certain area of a spreadsheet
using a simple macro? I want to copy one column (a part of it) so that each
content of each cell is in a single row in the txt-file. Thanks for your help.

This code will do it:


Sub RangeToText()

Dim arr
Dim varDialogResult
Dim strFile As String
Dim strFileName As String

strFileName = Replace(ActiveWorkbook.Name, ".xls", ".txt", 1, -1,
vbTextCompare)

varDialogResult = _
Application.GetSaveAsFilename(InitialFileName:=str FileName, _
FileFilter:="Text Files (*.txt), *.txt")

'to take care of a cancelled dialog
'----------------------------------
If varDialogResult = False Then
Exit Sub
Else
strFile = varDialogResult
End If

If bFileExists(strFile) Then
If MsgBox(strFile & _
vbCrLf & vbCrLf & _
"Already exists, overwrite this file?", _
vbYesNo + vbDefaultButton2 + vbQuestion, _
"save range to text file") = vbNo Then
Exit Sub
End If
End If

arr = ActiveWindow.RangeSelection

SaveArrayToText strFile, arr

End Sub

Public Function bFileExists(ByVal sFile As String) As Boolean

Dim lAttr As Long

On Error Resume Next
lAttr = GetAttr(sFile)
bFileExists = (Err.Number = 0) And ((lAttr And vbDirectory) = 0)
On Error GoTo 0

End Function

Sub SaveArrayToText(ByVal txtFile As String, _
ByRef arr As Variant, _
Optional ByVal LBRow As Long = -1, _
Optional ByVal UBRow As Long = -1, _
Optional ByVal LBCol As Long = -1, _
Optional ByVal UBCol As Long = -1, _
Optional ByRef fieldArr As Variant)

Dim r As Long
Dim c As Long
Dim hFile As Long

If LBRow = -1 Then
LBRow = LBound(arr, 1)
End If

If UBRow = -1 Then
UBRow = UBound(arr, 1)
End If

If LBCol = -1 Then
LBCol = LBound(arr, 2)
End If

If UBCol = -1 Then
UBCol = UBound(arr, 2)
End If

hFile = FreeFile

Open txtFile For Output As hFile

If IsMissing(fieldArr) Then
For r = LBRow To UBRow
For c = LBCol To UBCol
If c = UBCol Then
Write #hFile, arr(r, c)
Else
Write #hFile, arr(r, c);
End If
Next
Next
Else
For c = LBCol To UBCol
If c = UBCol Then
Write #hFile, fieldArr(c)
Else
Write #hFile, fieldArr(c);
End If
Next
For r = LBRow To UBRow
For c = LBCol To UBCol
If c = UBCol Then
Write #hFile, arr(r, c)
Else
Write #hFile, arr(r, c);
End If
Next
Next
End If

Close #hFile

End Sub


RBS


"Reedhill" wrote in message
...
Hi
How can I get a txt file (result003.txt) from certain area of a
spreadsheet
using a simple macro? I want to copy one column (a part of it) so that
each
content of each cell is in a single row in the txt-file. Thanks for your
help.