ExcelVBAでCSVファイルをExcelファイル化

CSVファイルをExcelファイルにして納品したい

は？と思う方もいるかもしれませんが、CSVファイルをそのまま開くと前0が落ちたりしますよね。
じゃあ全部文字列としてインポートすればいいじゃんと思ったら、財務的な部分は数字で欲しかったりします。
数項目くらいなら1つずつポチポチ設定すればいいけど100項目以上とかになるともう毎回やるのとか無理ってことでマクロの記録からツール化してみました。
UserFormで入出力ファイルの指定とかありますがそこは割愛します。

CSVtoExcel.bas

Sub CSVtoExcel()
    Dim Sheet As Worksheet
    Dim Folder As String
    Dim inFilePath As String
    Dim outFilePath As String
    Dim inFile As String
    Dim outFile As String
    Dim ans As Integer
    
    On Error GoTo myError
    
    ' マクロが存在するフォルダのパス
    Folder = ThisWorkbook.Path
    Sheet = Folder.Sheets("貼り付け先")
    
    inFilePath = メニュー.入力ファイルラベル.Caption
    outFilePath = メニュー.出力ファイルラベル.Caption
       
    inFile = Dir(inFilePath)
    outFile = Dir(outFilePath)
    
    If outFile <> "" Then
        ans = MsgBox(outFile & "が存在しますが実行しますか？" & vbCrLf & "※ファイルは上書きされます", vbOKCancel, Sheet.Name)
    Else
        ans = MsgBox(Sheet.Name & "変換を実行しますか？", vbOKCancel, Sheet.Name)
    End If
    
    If ans = vbOK Then
        Sheet.Select
        With Sheet.QueryTables.Add(Connection:="TEXT;" & inFilePath, Destination:=Range("$A$2"))
             .AdjustColumnWidth = False
             .TextFileCommaDelimiter = True
             .TextFileColumnDataTypes = Array(2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, _
             1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, _
             2, 2, 2, 2, 2, 2, 2, 2, 1, 1, 1, 2, 2, 1, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 1, 1, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, _
             1, 1, 2, 1, 2, 1, 2, 1, 2, 1, 2, 1, 2, 1, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2)
             .Refresh BackgroundQuery:=False
             .Delete
        End With
        
        Application.DisplayAlerts = False
        
        Sheet.Rows(2).Select
        ActiveWindow.FreezePanes = True
        Sheet.Range("A1").AutoFilter
        Sheet.Range("A1").Select
        Sheet.columns.AutoFit
        
        Sheet.Copy
        ActiveWorkbook.SaveAs FileName:=outFilePath, _
                                FileFormat:=xlWorkbookDefault, CreateBackup:=False
                     
        Application.DisplayAlerts = True
                                     
    Else
        Application.Quit
        ThisWorkbook.Close SaveChanges:=False
    End If
    
    Exit Sub
    
myError:
    MsgBox "エラー番号:" & Err.Number & vbCrLf & "エラーの種類:" & Err.Description, vbExclamation
    Application.ScreenUpdating = True
    Application.Visible = True

End Sub