Exporting Single column as .txt file

[Zlerp]

Hello,

I need help creating a macro that will take the data in a column and extract it all as a .txt file or if possible a .bat file. I would like that file saved in the same place the the workbook is saved.

For Example:

If i had data in a range of cells from A1:E50, how would i be able to extract the data E1:E50 as a .txt or .bat file saved in the same file location as the workbook with the data.

[GTO]

Hi Zlerp,

AFAIK, a .bat file is likely to be recognized as MS-DOS script file, so I chose .txt.

In a Standard Module:

Option Explicit
  
Sub Example()
Dim FSO           As Object ' Scripting.FileSystemObject
Dim fsoTStream    As Object ' Scripting.TextStream
Dim arrRangeData  As Variant
Dim sVersion      As String
Dim sPath         As String
Dim n             As Long
  
  Set FSO = CreateObject("Scripting.FileSystemObject")
  
  sPath = PF(ThisWorkbook.Path)
  arrRangeData = Sheet1.Range("E1:E50").Value
  
  If Not FSO.FileExists(sPath & "Output.txt") Then
    Set fsoTStream = FSO.CreateTextFile(sPath & "Output.txt", False)
  Else
    n = 0
    Do While FSO.FileExists(sPath & "Output" & sVersion & ".txt")
      n = n + 1
      sVersion = Format(n, "000")
    Loop
    If Not n = 999 Then
      Set fsoTStream = FSO.CreateTextFile(sPath & "Output" & sVersion & ".txt", False)
    Else
      MsgBox "Too many files...", vbExclamation, vbNullString
      Exit Sub
    End If
  End If
  
  For n = 1 To UBound(arrRangeData, 1)
    fsoTStream.WriteLine arrRangeData(n, 1)
  Next
  
  fsoTStream.Close
  
End Sub
  
'Path Fixed
Function PF(Path As String, Optional IncludeTrailingSeperator As Boolean = True) As String
  
  Do While Right$(Path, 1) = "\"
    Path = Left$(Path, Len(Path) - 1)
  Loop
  
  If IncludeTrailingSeperator Then Path = Path & "\"
  
  PF = Path
  
End Function

See the attached. Does that help?

Mark

[apo]

Here's another..

Private Sub CommandButton1_Click()
  Dim Rng As Range
        With CreateObject("Scripting.FileSystemObject").CreateTextFile(ThisWorkbook.Path & "Test" & ".txt", True)
            Set Rng = Cells(1, 5).Resize(50, 1)
            .writeline Join(Application.Transpose(Rng), vbCrLf)
        End With
End Sub

[snb]

Private Sub CommandButton1_Click() 
    CreateObject("Scripting.FileSystemObject").CreateTextFile(ThisWorkbook.Path & "\Test.txt").write Join([transpose(E1:E50)], vbCrLf) 
End Sub

[apo]

Very nice indeed snb..

[Zlerp]

Hey looking into it all now. Thanks

[Zlerp]

Hi Zlerp,

AFAIK, a .bat file is likely to be recognized as MS-DOS script file, so I chose .txt.

In a Standard Module:

Option Explicit
  
Sub Example()
Dim FSO           As Object ' Scripting.FileSystemObject
Dim fsoTStream    As Object ' Scripting.TextStream
Dim arrRangeData  As Variant
Dim sVersion      As String
Dim sPath         As String
Dim n             As Long
  
  Set FSO = CreateObject("Scripting.FileSystemObject")
  
  sPath = PF(ThisWorkbook.Path)
  arrRangeData = Sheet1.Range("E1:E50").Value
  
  If Not FSO.FileExists(sPath & "Output.txt") Then
    Set fsoTStream = FSO.CreateTextFile(sPath & "Output.txt", False)
  Else
    n = 0
    Do While FSO.FileExists(sPath & "Output" & sVersion & ".txt")
      n = n + 1
      sVersion = Format(n, "000")
    Loop
    If Not n = 999 Then
      Set fsoTStream = FSO.CreateTextFile(sPath & "Output" & sVersion & ".txt", False)
    Else
      MsgBox "Too many files...", vbExclamation, vbNullString
      Exit Sub
    End If
  End If
  
  For n = 1 To UBound(arrRangeData, 1)
    fsoTStream.WriteLine arrRangeData(n, 1)
  Next
  
  fsoTStream.Close
  
End Sub
  
'Path Fixed
Function PF(Path As String, Optional IncludeTrailingSeperator As Boolean = True) As String
  
  Do While Right$(Path, 1) = "\"
    Path = Left$(Path, Len(Path) - 1)
  Loop
  
  If IncludeTrailingSeperator Then Path = Path & "\"
  
  PF = Path
  
End Function

See the attached. Does that help?

Mark

Hey Mark,

Figured it out! Thanks for the help. Updated it slightly. check it out!

Option Explicit

Sub Example()
Dim FSO As Object ' Scripting.FileSystemObject
Dim fsoTStream As Object ' Scripting.TextStream
Dim arrRangeData As Variant
Dim sVersion As String
Dim sPath As String
Dim n As Long
Dim lastRow As Long
Set FSO = CreateObject("Scripting.FileSystemObject")
lastRow = FindLastRow(ActiveSheet, "J")

sPath = PF(ThisWorkbook.Path)
arrRangeData = Sheet1.Range("J1:J" & lastRow).Value

If Not FSO.FileExists(sPath & "Output.txt") Then
Set fsoTStream = FSO.CreateTextFile(sPath & "Output.txt", False)
Else
n = 0
Do While FSO.FileExists(sPath & "Output" & sVersion & ".txt")
n = n + 1
sVersion = Format(n, "000")
Loop
If Not n = 999 Then
Set fsoTStream = FSO.CreateTextFile(sPath & "Output" & sVersion & ".txt", False)
Else
MsgBox "Too many files...", vbExclamation, vbNullString
Exit Sub
End If
End If

For n = 1 To UBound(arrRangeData, 1)
fsoTStream.WriteLine arrRangeData(n, 1)
Next

fsoTStream.Close

End Sub

'Path Fixed
Function PF(Path As String, Optional IncludeTrailingSeperator As Boolean = True) As String

Do While Right$(Path, 1) = "\"
Path = Left$(Path, Len(Path) - 1)
Loop

If IncludeTrailingSeperator Then Path = Path & "\"

PF = Path

End Function
Public Function FindLastRow(ByVal WS As Worksheet, ColumnLetter As String) As Long
' this function will find the last row of the worksheet and column that you
' request
FindLastRow = WS.Range(ColumnLetter & Rows.Count).End(xlUp).Row
End Function

[GTO]

Hey Mark,

Figured it out! Thanks for the help. Updated it slightly. check it out!

You are most welcome and glad you got it working.

I would comment on one little part though:

  lastRow = FindLastRow(ActiveSheet, "J")

In calling FindLastRow(), you are sending a reference to the ActiveSheet to the Function.

arrRangeData = Sheet1.Range("J1:J" & lastRow).Value

In returning arrRangeData, the values from a range of Sheet1 (the CodeName, not the one on the tab) is being returned. Thus if another sheet happens to be active when the code runs, the last cell with data on that sheet is what sets lastRow. See what I mean? So it should either be ActiveSheet in both places, or specify which sheet explicitly in both places.

Hope that helps,

Mark

[Zlerp]

You are most welcome and glad you got it working.

I would comment on one little part though:

  lastRow = FindLastRow(ActiveSheet, "J")

In calling FindLastRow(), you are sending a reference to the ActiveSheet to the Function.

arrRangeData = Sheet1.Range("J1:J" & lastRow).Value

In returning arrRangeData, the values from a range of Sheet1 (the CodeName, not the one on the tab) is being returned. Thus if another sheet happens to be active when the code runs, the last cell with data on that sheet is what sets lastRow. See what I mean? So it should either be ActiveSheet in both places, or specify which sheet explicitly in both places.

Hope that helps,

Mark

Hey Mark,

Thanks for the Tips and information. I'll make those changes!

[GTO]

Happy to help.