Sub test1()
    With ActiveSheet.QueryTables.Add(Connection:= _
        "TEXT;" & ThisWorkbook.Path & "\CSV保存用\201301Data.csv" _
        , Destination:=Range("$A$1"))
        .Name = "201301Data"
        .FieldNames = True
        .RowNumbers = False
        .FillAdjacentFormulas = False
        .PreserveFormatting = True
        .RefreshOnFileOpen = False
        .RefreshStyle = xlInsertDeleteCells
        .SavePassword = False
        .SaveData = True
        .AdjustColumnWidth = True
        .RefreshPeriod = 0
        .TextFilePromptOnRefresh = False
        .TextFilePlatform = 932
        .TextFileStartRow = 1
        .TextFileParseType = xlDelimited
        .TextFileTextQualifier = xlTextQualifierDoubleQuote
        .TextFileConsecutiveDelimiter = False
        .TextFileTabDelimiter = True
        .TextFileSemicolonDelimiter = False
        .TextFileCommaDelimiter = True
        .TextFileSpaceDelimiter = False
        .TextFileColumnDataTypes = Array(2, 1, 1, 2, 1, 5, 1, 1, 1)
        .TextFileTrailingMinusNumbers = True
        .Refresh BackgroundQuery:=False
    End With
End Sub

Sub test2()
    With ActiveSheet.QueryTables.Add(Connection:= _
        "TEXT;" & ThisWorkbook.Path & "\CSV保存用\201301Data.csv" _
        , Destination:=Range("$A$1"))

'        .Name = "201301Data"
'        .FieldNames = True
'        .RowNumbers = False
'        .FillAdjacentFormulas = False
'        .PreserveFormatting = True
'        .RefreshOnFileOpen = False
'        .RefreshStyle = xlInsertDeleteCells
'        .SavePassword = False
'        .SaveData = True
'        .AdjustColumnWidth = True
'        .RefreshPeriod = 0
'        .TextFilePromptOnRefresh = False
'        .TextFilePlatform = 932
'        .TextFileStartRow = 1
'        .TextFileParseType = xlDelimited
'        .TextFileTextQualifier = xlTextQualifierDoubleQuote
'        .TextFileConsecutiveDelimiter = False
'        .TextFileTabDelimiter = True
'        .TextFileSemicolonDelimiter = False
        .TextFileCommaDelimiter = True
'        .TextFileSpaceDelimiter = False
        .TextFileColumnDataTypes = Array(2, 1, 1, 2, 1, 5, 1, 1, 1)
'        .TextFileTrailingMinusNumbers = True
        .Refresh BackgroundQuery:=False
        .Delete
    End With
End Sub

Sub test3()
    With ActiveSheet.QueryTables.Add(Connection:= _
        "TEXT;" & ThisWorkbook.Path & "\CSV保存用\201301Data.csv" _
        , Destination:=Range("A1"))

        .TextFileCommaDelimiter = True
        .TextFileColumnDataTypes = Array(2, 1, 1, 2, 1, 5, 1, 1, 1)
        .Refresh BackgroundQuery:=False
        .Delete
    End With
End Sub

Sub test3()
        '外部データソースから返されるデータをアクティブシートのA1セルを起点に表示
        'させるクエリテーブルが作成される。
    With ActiveSheet.QueryTables.Add(Connection:= _
        "TEXT;" & ThisWorkbook.Path & "\CSV保存用\201301Data.csv" _
        , Destination:=Range("A1"))
        'カンマ区切りでインポート
        .TextFileCommaDelimiter = True
        'テキストファイルの各列に適用されるデータ型を指定する定数を配列形式で設定。
        .TextFileColumnDataTypes = Array(2, 1, 1, 2, 1, 5, 1, 1, 1)
        '外部データ範囲（QueryTable）を更新。（上で作られたクエリはRefreshして初めて実行される。）
        .Refresh BackgroundQuery:=False
        'QueryTableを削除してただのデータにする。
        .Delete
    End With
End Sub

Option Explicit

'***外部データの取込みを毎月1回***
Sub データ取込()
    Dim Nengetu As Long
    Dim FName As String
    Dim trSh As Worksheet
    Dim LastRow As Long
    Dim LR As Long, i As Long

    '取込用シートを変数に入れる
    Set trSh = Worksheets("取込用")
    '前回データをクリア（ないはずだけど、一応。テストもあるので。）
    trSh.Cells.Clear

    '対象年月取得
    Nengetu = Application.InputBox _
            (prompt:="対象年月西暦を 6桁の数字で 201403 のように入力してください。" _
	    , Title:="対象年月は？", Type:=1)
    If Nengetu = 0 Then
        Exit Sub
    End If

    'CSVファイル名を変数に取得
    FName = Dir(ThisWorkbook.Path & "\CSV保存用\" & Nengetu & "Data.CSV")

    'ファイルの存在を確認
    If FName = "" Then
        MsgBox "取り込みファイルの準備がまだのようです。" & vbCrLf & "確認してください。"
        Exit Sub
    End If

    '既に取りこんでいないかどうかを確認
    With Worksheets("取込ファイル名")
        LR = .Cells(.Rows.Count, 1).End(xlUp).Row
        For i = 2 To LR
            If .Cells(i, 1).Value = FName Then
                MsgBox "そのファイルは取り込み済です。"
                Exit Sub
            End If
        Next i
        'ここに来るのはまだ取りこんでない場合なので、ファイル名を入力
        .Cells(LR + 1, 1).Value = FName
    End With

    '外部データの取り込みでデータを取得
    With trSh.QueryTables.Add(Connection:= _
        "TEXT;" & ThisWorkbook.Path & "\CSV保存用\" & FName _
        , Destination:=trSh.Range("A1"))
        .TextFileCommaDelimiter = True
        .TextFileColumnDataTypes = Array(2, 1, 1, 2, 1, 5, 1, 1, 1)
        .Refresh BackgroundQuery:=False
        .Delete
    End With

    '和暦の6桁の数字を日付に変換
    With trSh
        LR = .Cells(.Rows.Count, 1).End(xlUp).Row
        'データ範囲と離れたAA列を作業列にして、そこに変換する数式を設定
        'とりあえず「平成」と限定して、6桁数値に19880000を加算し、TEXT関数で日付表示にして変換。
        .Range("AA2:AA" & LR).FormulaR1C1 = "=TEXT(RC7+19880000,""0000!/00!/00"")*1"
        'G列にAA列の数式の結果の値を代入
        .Range("G2:G" & LR).Value = .Range("AA2:AA" & LR).Value
        'G列の表示形式を和暦に設定
        .Columns("G:G").NumberFormatLocal = "ge.m.d"
        '作業列のAA列をクリア
        .Columns("AA:AA").Clear
    End With

    With Worksheets("Data")
        LastRow = .Cells(.Rows.Count, 1).End(xlUp).Row
        'データシートに項目行を除いて追加
        trSh.Range("A1").CurrentRegion.Offset(1).Copy Destination:=.Cells(LastRow + 1, 1)
    End With
    '取込用シートをクリア
    trSh.Cells.Clear

'    '上書き保存
'    ThisWorkbook.Save
    MsgBox "取込が終わりました。"
End Sub