Option Explicit
 
Public Sub CSV読み込み()
    Dim csvFile As String
    Dim wb As Workbook
    Dim ws As Worksheet
    Dim qTb As QueryTable
    Dim qCon As String
    Dim qDst As Range
    Dim attr(27) As Long
    Dim i As Long
    ' CSV ファイル名を選択
    csvFile = Application.GetOpenFilename(FileFilter:="CSV Files (*.csv), *.csv", Title:="CSVファイルを選択")
    If csvFile = "False" Then Exit Sub
    '取り込み用作業シートをクリア
    Set ws = Worksheets("Sheet1")
    ws.Cells.ClearContents
    '取り込み列の属性を設定
    For i = 0 To UBound(attr)
        attr(i) = xlGeneralFormat               '一般形式
        If i = 5 Then attr(i) = xlTextFormat    'F列は文字形式
        If i = 24 Then attr(i) = xlTextFormat   'Y列は文字形式
    Next
    'QueryTable実行
    qCon = "Text;" & csvFile
    Set qDst = ws.Range("A1")
    Set qTb = ws.QueryTables.Add(Connection:=qCon, Destination:=qDst)
    With qTb
        .TextFilePlatform = 932                 ' 文字コードを指定
        .TextFileParseType = xlDelimited        ' 区切り文字の形式
        .TextFileCommaDelimiter = True          ' カンマ区切り
        .RefreshStyle = xlOverwriteCells        ' セルに書き込む方式
        .TextFileStartRow = 1                   '開始行
        .TextFileTextQualifier = xlTextQualifierDoubleQuote
        .TextFileColumnDataTypes = attr         '各列の属性
        .Refresh                                ' データを表示
        .Delete                                 ' CSVファイルとの接続を解除
    End With
    '新規ブックへコピー
    ws.Copy
    'このマクロのブックを保存して閉じる
    ThisWorkbook.Save
    ThisWorkbook.Close
 
End Sub
 
 

T3B0aW9uIEV4cGxpY2l0CgpQdWJsaWMgU3ViIENTVuiqreOBv+i+vOOBvygpCiAgICBEaW0gY3N2RmlsZSBBcyBTdHJpbmcKICAgIERpbSB3YiBBcyBXb3JrYm9vawogICAgRGltIHdzIEFzIFdvcmtzaGVldAogICAgRGltIHFUYiBBcyBRdWVyeVRhYmxlCiAgICBEaW0gcUNvbiBBcyBTdHJpbmcKICAgIERpbSBxRHN0IEFzIFJhbmdlCiAgICBEaW0gYXR0cigyNykgQXMgTG9uZwogICAgRGltIGkgQXMgTG9uZwogICAgJyBDU1Yg44OV44Kh44Kk44Or5ZCN44KS6YG45oqeCiAgICBjc3ZGaWxlID0gQXBwbGljYXRpb24uR2V0T3BlbkZpbGVuYW1lKEZpbGVGaWx0ZXI6PSJDU1YgRmlsZXMgKCouY3N2KSwgKi5jc3YiLCBUaXRsZTo9IkNTVuODleOCoeOCpOODq+OCkumBuOaKniIpCiAgICBJZiBjc3ZGaWxlID0gIkZhbHNlIiBUaGVuIEV4aXQgU3ViCiAgICAn5Y+W44KK6L6844G/55So5L2c5qWt44K344O844OI44KS44Kv44Oq44KiCiAgICBTZXQgd3MgPSBXb3Jrc2hlZXRzKCJTaGVldDEiKQogICAgd3MuQ2VsbHMuQ2xlYXJDb250ZW50cwogICAgJ+WPluOCiui+vOOBv+WIl+OBruWxnuaAp+OCkuioreWumgogICAgRm9yIGkgPSAwIFRvIFVCb3VuZChhdHRyKQogICAgICAgIGF0dHIoaSkgPSB4bEdlbmVyYWxGb3JtYXQgICAgICAgICAgICAgICAn5LiA6Iis5b2i5byPCiAgICAgICAgSWYgaSA9IDUgVGhlbiBhdHRyKGkpID0geGxUZXh0Rm9ybWF0ICAgICdG5YiX44Gv5paH5a2X5b2i5byPCiAgICAgICAgSWYgaSA9IDI0IFRoZW4gYXR0cihpKSA9IHhsVGV4dEZvcm1hdCAgICdZ5YiX44Gv5paH5a2X5b2i5byPCiAgICBOZXh0CiAgICAnUXVlcnlUYWJsZeWun+ihjAogICAgcUNvbiA9ICJUZXh0OyIgJiBjc3ZGaWxlCiAgICBTZXQgcURzdCA9IHdzLlJhbmdlKCJBMSIpCiAgICBTZXQgcVRiID0gd3MuUXVlcnlUYWJsZXMuQWRkKENvbm5lY3Rpb246PXFDb24sIERlc3RpbmF0aW9uOj1xRHN0KQogICAgV2l0aCBxVGIKICAgICAgICAuVGV4dEZpbGVQbGF0Zm9ybSA9IDkzMiAgICAgICAgICAgICAgICAgJyDmloflrZfjgrPjg7zjg4njgpLmjIflrpoKICAgICAgICAuVGV4dEZpbGVQYXJzZVR5cGUgPSB4bERlbGltaXRlZCAgICAgICAgJyDljLrliIfjgormloflrZfjga7lvaLlvI8KICAgICAgICAuVGV4dEZpbGVDb21tYURlbGltaXRlciA9IFRydWUgICAgICAgICAgJyDjgqvjg7Pjg57ljLrliIfjgooKICAgICAgICAuUmVmcmVzaFN0eWxlID0geGxPdmVyd3JpdGVDZWxscyAgICAgICAgJyDjgrvjg6vjgavmm7jjgY3ovrzjgoDmlrnlvI8KICAgICAgICAuVGV4dEZpbGVTdGFydFJvdyA9IDEgICAgICAgICAgICAgICAgICAgJ+mWi+Wni+ihjAogICAgICAgIC5UZXh0RmlsZVRleHRRdWFsaWZpZXIgPSB4bFRleHRRdWFsaWZpZXJEb3VibGVRdW90ZQogICAgICAgIC5UZXh0RmlsZUNvbHVtbkRhdGFUeXBlcyA9IGF0dHIgICAgICAgICAn5ZCE5YiX44Gu5bGe5oCnCiAgICAgICAgLlJlZnJlc2ggICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICcg44OH44O844K/44KS6KGo56S6CiAgICAgICAgLkRlbGV0ZSAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICcgQ1NW44OV44Kh44Kk44Or44Go44Gu5o6l57aa44KS6Kej6ZmkCiAgICBFbmQgV2l0aAogICAgJ+aWsOimj+ODluODg+OCr+OBuOOCs+ODlOODvAogICAgd3MuQ29weQogICAgJ+OBk+OBruODnuOCr+ODreOBruODluODg+OCr+OCkuS/neWtmOOBl+OBpumWieOBmOOCiwogICAgVGhpc1dvcmtib29rLlNhdmUKICAgIFRoaXNXb3JrYm9vay5DbG9zZQogICAgCkVuZCBTdWIKCg==