VBA导出UTF-8格式的TXT文本

这个一个工作簿的导出，多个的话加个循环。
导出时间有点慢，如果你知道怎么改善，感谢留言！

Sub test()
    Dim arr, myPath As String, s As String
    arr = Range("a1").CurrentRegion
    myPath = ThisWorkbook.Path & "\" & Left(ThisWorkbook.Name, InStr(ThisWorkbook.Name, ".")) & "txt"
    For i = 1 To UBound(arr)
        For j = 1 To UBound(arr, 2)
            If j = 1 Then
                If i = 1 Then
                    s = s & Cells(i, j).Text
                Else
                    s = s & vbCrLf & Cells(i, j).Text
                End If
            Else
                s = s & vbTab & Cells(i, j).Text
            End If
        Next
    Next
    Rem Open myPath For Output As #1
    Rem Print #1, s
    Rem Close #1
    
    Dim objStream As Object
    Set objStream = CreateObject("ADODB.Stream")
    With objStream
        .Type = 2
        .Charset = "UTF-8"
        .Open
        .WriteText s
        .SaveToFile myPath, 2
    End With

End Sub