Consulting

Results 1 to 10 of 10

Thread: Exporting Single column as .txt file

  1. #1
    VBAX Regular
    Joined
    Aug 2014
    Posts
    49
    Location

    Exclamation Exporting Single column as .txt file

    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.

  2. #2
    Knowledge Base Approver VBAX Guru GTO's Avatar
    Joined
    Sep 2008
    Posts
    3,362
    Location
    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
    Attached Files Attached Files

  3. #3
    VBAX Regular
    Joined
    Jul 2013
    Posts
    56
    Location
    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
    Attached Files Attached Files

  4. #4
    Knowledge Base Approver VBAX Guru
    Joined
    Apr 2012
    Posts
    4,747
    Private Sub CommandButton1_Click() 
        CreateObject("Scripting.FileSystemObject").CreateTextFile(ThisWorkbook.Path & "\Test.txt").write Join([transpose(E1:E50)], vbCrLf) 
    End Sub

  5. #5
    VBAX Regular
    Joined
    Jul 2013
    Posts
    56
    Location
    Very nice indeed snb..

  6. #6
    VBAX Regular
    Joined
    Aug 2014
    Posts
    49
    Location
    Hey looking into it all now. Thanks
    Last edited by Zlerp; 08-26-2014 at 09:47 AM. Reason: Quoting someone

  7. #7
    VBAX Regular
    Joined
    Aug 2014
    Posts
    49
    Location
    Quote Originally Posted by GTO View Post
    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
    Last edited by Zlerp; 08-26-2014 at 10:26 AM.

  8. #8
    Knowledge Base Approver VBAX Guru GTO's Avatar
    Joined
    Sep 2008
    Posts
    3,362
    Location
    Quote Originally Posted by Zlerp View Post
    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

  9. #9
    VBAX Regular
    Joined
    Aug 2014
    Posts
    49
    Location
    Quote Originally Posted by GTO View Post
    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!

  10. #10
    Knowledge Base Approver VBAX Guru GTO's Avatar
    Joined
    Sep 2008
    Posts
    3,362
    Location
    Happy to help.

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •