Option Explicit

Sub ExportRangeToTXT(exportRangeName As String)

'This function exports a range into a text file

'Create a new module and paste this code into it

'Create a range named "exportfileFullPath" (with only one cell) with the export text file path
'ex.: C:\MoxyDraw\MoxyDraw.txt
'**The function needs this range name to operate**

'Create a range name containing MoxyDraw commands
'This range name can be named any name and should be passed to this function using a button
'ex.: exportRange
'**The function needs this range name to operate**

'Create a button in your spreadsheet that calls this function with the name of the range to be exported.
'ex.: ExportRangeToTXT ("exportRange")

'Create another button to open the file
'ex.: OpenFile

'Another button could be created to clear the selected range
'ex.: ClearRange ("exportRange")

    Dim fso, stream, binaryStream As Object
    Dim row, col, rangeToExport As Range
    Dim fileFullPath, folder, textLine As String
    Dim numberErrors As Integer
    
    'Set the scripting file System
    Set fso = CreateObject("scripting.filesystemobject")
        
    'Set the text file name
    On Error GoTo fileFullPathRangeError
        fileFullPath = Range("exportfileFullPath")
    On Error GoTo 0
    
    'Get the Folder
    folder = Left(fileFullPath, InStrRev(fileFullPath, Application.PathSeparator)) ' or "\"
    
    'Check if the folder exists
    If Not fso.FolderExists(folder) Then

        MsgBox "File path doesn't exists."

        Exit Sub

    End If

    'Set the export range and check if range exists
    On Error GoTo ExportRangeError
        Set rangeToExport = Range(exportRangeName)
    On Error GoTo 0

    'Set the text stream
    Set stream = CreateObject("ADODB.Stream")
    
    With stream
        .Type = 2           'adTypeText, Specify the stream type as text
        .Charset = "UTF-8"  'Specify the character set as UTF-8 this will be UTF-8 BOM (Byte Order Mark)
        .Open               'Open the stream
    End With

    'Reset the number of errors
    numberErrors = 0

    For Each row In rangeToExport.Rows
            
        'Reset text line content
        textLine = ""
    
        'Find cell content and separate it with a tab
        For Each col In row.Cells
            
            'Check if there is an error in the cell
            If IsError(col.Value) Then
                textLine = textLine & "ERR" & vbTab
                numberErrors = numberErrors + 1
            Else
              textLine = textLine & col.Value & vbTab
            End If
              
        Next col
     
        'Write the line to stream
        stream.WriteText textLine, 1 'adWriteLine
                
    Next row
    
    'Strips BOM (first 3 bytes of UTF-8 BOM file)
    stream.Position = 3
    
    'We need to set a second stream in binary to remove the BOM
    
    'Set the binary stream to convert the UTF-8 BOM to UTF-8
    Set binaryStream = CreateObject("ADODB.Stream")
    
    With binaryStream
        .Type = 1       'adTypeBinary, Specify the stream type as binary
        .Mode = 3       'adModeReadWrite 'Specify the stream mode
        .Open           'Open the stream
    End With

    'Copy the text stream to the binary stream
    stream.CopyTo binaryStream

    'Save the file
    'stream.SaveToFile fileFullPath, 2          'adSaveCreateOverWrite 'UTF-8 BOM
    binaryStream.SaveToFile fileFullPath, 2     'adSaveCreateOverWrite 'UTF-8
    
    'Clean up
    stream.Flush
    stream.Close
    binaryStream.Flush
    binaryStream.Close

    'Show a message box if there are errors
    If numberErrors >= 1 Then
        MsgBox "There " & IIf(numberErrors > 1, "are", "is") & numberErrors & " error" & IIf(numberErrors > 1, "s", "") & " in the export range." & _
        vbNewLine & _
        vbNewLine & _
        "In this export range, look for" & _
        vbNewLine & _
        "#REF!, #N/A!, #VALUE!, #NAME!, #DIV/0!, #NAME! etc." & _
        vbNewLine & _
        vbNewLine & _
        "The TEXT file is generated anyway. Look for ""ERR"" values inside it."
    End If
    
    Exit Sub

fileFullPathRangeError:
    
    MsgBox "The fileFullPath range named 'exportfileFullPath' doesn't exists."
    
    Exit Sub
    
ExportRangeError:
    
    MsgBox "The export range named 'ExportRangeToTXT' doesn't exists."
    
    Exit Sub

End Sub

Sub RemoveBOM(ByVal fileFullPath As String) 'Not used but can be very helpfull!!

'Change an UTF-8 BOM to an UTF-8 without BOM

    Dim objStreamUTF8, objStreamUTF8noBOM
    Set objStreamUTF8 = CreateObject("ADODB.Stream")
    Set objStreamUTF8noBOM = CreateObject("ADODB.Stream")
    
    With objStreamUTF8
        .Charset = "UTF-8"
        .Open
        .LoadFromFile fileFullPath
        .Type = 2 'adTypeText
        .Position = 3
    End With

    With objStreamUTF8noBOM
       .Type = 1 'adTypeBinary
       .Open
       objStreamUTF8.CopyTo objStreamUTF8noBOM
       .SaveToFile fileFullPath, 2 'adSaveCreateOverWrite
    End With

    objStreamUTF8.Close
    objStreamUTF8noBOM.Close

End Sub

Sub OpenFile()

    Shell "explorer.exe" & " " & Range("exportfileFullPath"), vbNormalFocus

End Sub

Sub ClearRange(rangeToClear As String)

    Range(rangeToClear).ClearContents

End Sub