Shenanigator
Shenanigator

Reputation: 1066

Save Array as Tab Delimited Text file in VBA

Sub ExportDataTSV()
Dim BCS As Worksheet
Dim Ctrl As Worksheet
Dim ws As Worksheet
Dim FName As String
Dim insertValues As String

Application.ScreenUpdating = False

Set BCS = ThisWorkbook.Sheets(Sheet2.Name)
Set Ctrl = ThisWorkbook.Sheets(Sheet1.Name)

#If Mac Then
    NameFolder = "documents folder"

    If Int(Val(Application.Version)) > 14 Then
    'You run Mac Excel 2016
    folder = _
    MacScript("return POSIX path of (path to " & NameFolder & ") as string")
    'Replace line needed for the special folders Home and documents
    folder = _
    Replace(SpecialFolder, "/Library/Containers/com.microsoft.Excel/Data", "")
    Else
    'You run Mac Excel 2011
    folder = MacScript("return (path to " & NameFolder & ") as string")
    End If
    
    FName = folder & "bcs_output.tsv"
#Else
    folder = Environ$("userprofile")
    Debug.Print folder
    FName = folder & "Documents\bcs_output.tsv"
#End If

If Ctrl.Range("D9") = "" Or Ctrl.Range("D10") = "" Then
    MsgBox "Please enter the Scenario Year and Scenario you wish to save and click again", vbOKOnly
    Exit Sub
End If

Ctrl.Range("D9").Copy
BCS.Range("AS2").PasteSpecial Paste:=xlPasteValues

Ctrl.Range("D10").Copy
BCS.Range("AT2").PasteSpecial Paste:=xlPasteValues

With BCS
    numrows = .Cells(.Rows.Count, 1).End(xlUp).Row
    numcol = .Cells(2, Columns.Count).End(xlToLeft).Column
    .Range("AS1").Value = "scenario_year"
    .Range("AS2:AS" & numrows).FillDown
    .Range("AT1").Value = "scenario"
    .Range("AT2:AT" & numrows).FillDown
    .Range("AU1").Value = "save_date"
    .Range("AU2").Formula = "=NOW()"
    .Range("AU2:AU" & numrows).FillDown
    .Range("AU2:AU" & numrows).NumberFormat = "yyyy-mm-dd hh:mm"
    For x = 2 To numrows
        Set rng1 = .Range("A" & x & ":R" & x)
        Set rng2 = .Range("AC" & x & ":AF" & x)
        Set rng3 = .Range("AH" & x & ":AK" & x)
        Set rng4 = .Range("AN" & x & ":AO" & x)
        Set rng5 = .Range("AS" & x & ":AU" & x)
        Set Data = Union(rng1, rng2, rng3, rng4, rng5)
    
        insertValues = Join2D(ToArray(Data), Chr(9))
        Debug.Print insertValues
        Call ConvertText(FName, insertValues)
    Next x
End With

With BCS
    .Activate
    .Range("A1").Select
End With

Ctrl.Activate
Application.ScreenUpdating = True

MsgBox "Cluster Data saved to your documents folder, please upload the file here: ", vbOKOnly

End Sub

Function ToArray(rng) As Variant()
    Dim arr() As Variant, r As Long, nr As Long
    Dim ar As Range, c As Range, cnum As Long, rnum As Long
    Dim col As Range

    nr = rng.Areas(1).Rows.Count
    ReDim arr(1 To nr, 1 To rng.Cells.Count / nr)
    cnum = 0
    For Each ar In rng.Areas
        For Each col In ar.Columns
        cnum = cnum + 1
        rnum = 1
        For Each c In col.Cells
            arr(rnum, cnum) = c.Value
            rnum = rnum + 1
        Next c
        Next col
    Next ar

    ToArray = arr
End Function
Public Function Join2D(ByVal vArray As Variant, Optional ByVal sWordDelim As String = " ", Optional ByVal sLineDelim As String = vbNewLine) As String
    
    Dim i As Long, j As Long
    Dim aReturn() As String
    Dim aLine() As String
    
    ReDim aReturn(LBound(vArray, 1) To UBound(vArray, 1))
    ReDim aLine(LBound(vArray, 2) To UBound(vArray, 2))
    
    For i = LBound(vArray, 1) To UBound(vArray, 1)
        For j = LBound(vArray, 2) To UBound(vArray, 2)
            'Put the current line into a 1d array
            aLine(j) = vArray(i, j)
        Next j
        'Join the current line into a 1d array
        aReturn(i) = Join(aLine, sWordDelim)
    Next i
    
    Join2D = Join(aReturn, sLineDelim)
    
End Function
Function ConvertText(myfile As String, strTxt As String)
    Dim objStream

    Set objStream = CreateObject("ADODB.Stream")
    With objStream
        '.Charset = "utf-8"
        .Open
        .WriteText strTxt
        .SaveToFile myfile, 2
        '.Close
    End With
    'Set objStream = Nothing

End Function

I attempted the above to write the non-contiguous ranges to a tab delimited file. I get a 3004 error - Unable to write file from that code. I am not sure why it can't write the file and since I can't even write the file I can't tell if it will write each row of data until there are no more. Can anyone assist with at least helping me get the file to write?

Upvotes: 2

Views: 454

Answers (1)

BDra
BDra

Reputation: 506

You need to separate folder and "Documents\bcs_output.tsv" with a backslash. In MacOS I believe the path separator is ":" (colon), not "\" (backslash).

Upvotes: 1

Related Questions