Results 1 to 30 of 30

Exporting files to text files

Threaded View

  1. #5
    Registered User
    Join Date
    08-02-2012
    Location
    Dordrecht, Netherlands
    MS-Off Ver
    Excel 2010
    Posts
    31

    Re: Exporting files to text files

    Ok I will post it here, this is my code in the userform:

    ----------------------------------------
    Private Sub cmbClose_Click()
       Unload Me
    End Sub
    
    Private Sub cmbGenerate_Click()
    
    End Sub
    
    Sub DoTheExport()
        Dim FileName As Variant
        Dim Sep As String
        FileName = Application.GetSaveAsFilename(InitialFileName:=vbNullString, FileFilter:="Text Files (*.txt),*.txt")
        If FileName = False Then
            ''''''''''''''''''''''''''
            ' user cancelled, get out
            ''''''''''''''''''''''''''
            Exit Sub
        End If
        Sep = Application.InputBox("Enter a separator character.", Type:=2)
        If Sep = vbNullString Then
            ''''''''''''''''''''''''''
            ' user cancelled, get out
            ''''''''''''''''''''''''''
            Exit Sub
        End If
        Debug.Print "FileName: " & FileName, "Separator: " & Sep
        ExportToTextFile FName:=CStr(FileName), Sep:=CStr(Sep), _
           SelectionOnly:=False, AppendData:=True
    
    End Sub
    ----------------------------------------

    The button "close" working haha. But I agree that's a basic one.

    Furthermore the module "DoTheExport"

    -----------------------------
    Public Sub ExportToTextFile(FName As String, _
        Sep As String, SelectionOnly As Boolean, _
        AppendData As Boolean)
    
    Dim WholeLine As String
    Dim FNum As Integer
    Dim RowNdx As Long
    Dim ColNdx As Integer
    Dim StartRow As Long
    Dim EndRow As Long
    Dim StartCol As Integer
    Dim EndCol As Integer
    Dim CellValue As String
    
    
    Application.ScreenUpdating = False
    On Error GoTo EndMacro:
    FNum = FreeFile
    
    If SelectionOnly = True Then
        With Selection
            StartRow = .Cells(1).Row
            StartCol = .Cells(1).Column
            EndRow = .Cells(.Cells.Count).Row
            EndCol = .Cells(.Cells.Count).Column
        End With
    Else
        With ActiveSheet.UsedRange
            StartRow = .Cells(1).Row
            StartCol = .Cells(1).Column
            EndRow = .Cells(.Cells.Count).Row
            EndCol = .Cells(.Cells.Count).Column
        End With
    End If
    
    If AppendData = True Then
        Open FName For Append Access Write As #FNum
    Else
        Open FName For Output Access Write As #FNum
    End If
    
    For RowNdx = StartRow To EndRow
        WholeLine = ""
        For ColNdx = StartCol To EndCol
            If Cells(RowNdx, ColNdx).Value = "" Then
                CellValue = Chr(34) & Chr(34)
            Else
               CellValue = Cells(RowNdx, ColNdx).Value
            End If
            WholeLine = WholeLine & CellValue & Sep
        Next ColNdx
        WholeLine = Left(WholeLine, Len(WholeLine) - Len(Sep))
        Print #FNum, WholeLine
    Next RowNdx
    
    EndMacro:
    On Error GoTo 0
    Application.ScreenUpdating = True
    Close #FNum
    
    End Sub
    -----------------------------

    Regards,

    Erwin
    Last edited by Cutter; 08-02-2012 at 05:45 PM. Reason: Added code tags

Thread Information

Users Browsing this Thread

There are currently 1 users browsing this thread. (0 members and 1 guests)

Bookmarks

Posting Permissions

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

Search Engine Friendly URLs by vBSEO 3.6.0 RC 1