外部システムからダウンロードしたcsv（UTF-8）を、querytableで読み込み表示形式を変更し、
別システムへアップロードするcsvとして保存するマクロを作成したいのですが、
UTF-8の文字コードでcsv保存はできるのですが、それをインポートウィザードで開いた際に、
もとのcsvにはAI列までしかデータがないにも関わらず、AJ列〜AN列の1行目に「_1」「_2」...といったよくわからない文字列が追加されていまいます。
解消法はありますでしょうか。
Option Explicit
Sub con()
Dim Ws As Worksheet
Dim wb As Workbook
Dim wbs As Worksheet
Dim Qt As QueryTable
Dim AAAAA As Variant
Dim Path As String
Dim Exp As String
Dim FolderDate As Variant
Dim FolderPath As Variant
Dim FileName As Variant
Dim r As Long
FolderDate = Format(Date, "yyyymmdd")
FileName = "xxx"
FolderPath = "C:\Users"
Application.ScreenUpdating = False
AAAAA = Application.GetOpenFilename("CSVファイル(*.csv),*.csv")
If AAAAA = "False" Then Exit Sub
Path = "TEXT;" & AAAAA
Set wb = Workbooks.Add
Set wbs = ActiveSheet
Set Qt = wbs.QueryTables.Add(Connection:=Path, Destination:=wbs.Range("A1:AI100")) ' CSV を開く
With Qt
.TextFilePlatform = 65001 ' 文字コードを指定
.TextFileParseType = xlDelimited ' 区切り文字の形式
.TextFileCommaDelimiter = True ' カンマ区切り
.TextFileColumnDataTypes = Array(2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2)
.RefreshStyle = xlOverwriteCells ' セルに上書き
.Refresh ' データを表示
.Delete ' CSV との接続を解除
End With
With ActiveSheet
.Range("C:C").NumberFormatLocal = "yyyy-mm-dd"
End With
Dim i As Long
Dim j As Long
Dim strList As String
Dim adoSt As Object
Set adoSt = CreateObject("ADODB.Stream")
With adoSt
.Type = adTypeText
.Charset = "UTF-8"
.Open
End With
With ActiveSheet.UsedRange
For i = 1 To .Rows.Count
strList = ""
For j = 1 To 35
If j > 1 Then
strList = strList & ","
End If
strList = strList & .Cells(i, j)
Next
adoSt.WriteText strList, adWriteLine
Next
End With
r = 1
Do Until Dir("C:\Users" & "\" & FileName & "_" & FolderDate & ".csv") = ""
FolderDate = FolderDate & "_" & r
r = r + 1
Loop
adoSt.SaveToFile "C:\Users" & "\" & FileName & "_" & FolderDate & ".csv", adSaveCreateOverWrite
adoSt.Close
Set adoSt = Nothing
ActiveWorkbook.Close saveChanges:=False
Application.ScreenUpdating = True
End Sub
