Save Array as Tab Delimited Text file in VBA - excel

Question

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?

Answer 1

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