'=========================================================================================
' 026 CSVファイルを文字列として開く
'-----------------------------------------------------------------------------------------
'【ヒント】
' このマクロは、おためし機能の動作用のコードを含んでいます。（概ね下半分）
' ★★★の行またはサブプロシージャーが、タイトル機能に関係するコードです。（概ね上半分）


'=========================================================================================
' ◆標準モジュールのコード◆
'-----------------------------------------------------------------------------------------
Option Explicit
Dim ドライブ As String                          '★★★
Dim フォルダ名 As String                        '★★★
Dim ファイル名 As String                        '★★★
Dim 拡張子 As String                            '★★★
Dim フルパスCSV As String                       '★★★
Dim フルパスTXT As String                       '★★★
Dim 現在の名前 As String                        '★★★
Dim 新しい名前 As String                        '★★★
Dim タイトル As String
Dim スタイル As Long
Dim メッセージ As String
Dim 応答 As Variant


'=========================================================================================
Private Sub CSVファイルを文字列として開く()      '★★★
    環境設定する
    拡張子を変更する
    TXTファイルを開く
End Sub
'-----------------------------------------------------------------------------------------
Private Sub 環境設定する()                      '★★★
    ドライブ = Worksheets("Title").Range("E11").Value               'ドライブ番号を取得する
    フォルダ名 = Worksheets("Title").Range("E12").Value             'フォルダ名を　　〃
    ファイル名 = Worksheets("Title").Range("E13").Value             'ファイル名を　　〃
    拡張子 = Worksheets("Title").Range("E14").Value                 '拡張子を　　　〃
    ChDrive ドライブ                            'カレントドライブを変更する
    ChDir ドライブ & ":\" & フォルダ名          'カレントフォルダを　〃
    フルパスCSV = ドライブ & ":\" & フォルダ名 & _
            "\" & ファイル名 & "." & 拡張子     'CSVファイルとしてのフルパスを組んでおく
    フルパスTXT = ドライブ & ":\" & フォルダ名 & _
            "\" & ファイル名 & "." & "txt"     'TXTファイルとしてのフルパスを組んでおく
End Sub
'-----------------------------------------------------------------------------------------
Private Sub 拡張子を変更する()                  '★★★
    現在の名前 = ファイル名 & ".csv"            'CSVファイルとしての名前
    新しい名前 = ファイル名 & ".txt"            'TXT　　〃　　　　〃
    On Error Resume Next                       '次行のKillがエラーならその次行を実行する
    Kill 新しい名前                             '同名のファイルが存在していたら削除する
    Name 現在の名前 As 新しい名前               'TXTファイルに変更する
End Sub
'-----------------------------------------------------------------------------------------
Private Sub TXTファイルを開く()                 '★★★
    Workbooks.OpenText Filename:=フルパスTXT, StartRow:=1 _
        , DataType:=xlDelimited, TextQualifier:=xlDoubleQuote, _
        ConsecutiveDelimiter:=False, Tab:=True, Semicolon:=False, Comma:=True, _
        Space:=False, Other:=False, FieldInfo:=Array(Array(1, 1), Array(2, 1), Array( _
        3, 1), Array(4, 2), Array(5, 1))
    Columns("A:E").EntireColumn.AutoFit         '列幅を最適化する
End Sub
'=========================================================================================



'-----------------------------------------------------------------------------------------
Sub おためしマクロ()
    Worksheets("Title").Select
    Range("O17").Select                         'カーソルを定位置へ移動する
    環境設定する                                'おためしメッセージ表示・テストデータ作成用
    おためしメッセージを表示する
    If 応答 = vbYes Then
        テストデータを作成する
        CSVファイルを文字列として開く           '★★★
        ユーザーに結果を確認してもらう
        テスト用に作ったTXTファイルを削除する
    End If
End Sub
'-----------------------------------------------------------------------------------------
Private Sub おためしメッセージを表示する()
    タイトル = "500連発 第2弾 サンプルマクロ"
    スタイル = 32 + 4                           'vbQuestion + vbYesNo
    メッセージ = "テスト用の少量データを " & ドライブ & "ドライブの、" & フォルダ名 & "フォルダへ、" & Chr(13) & Chr(13) & _
                "ファイル名を 「" & ファイル名 & ".csv と 同.txt」 として書き込みます。" & Chr(13) & Chr(13) & _
                "よろしいですか   （終了後は削除されます）"
    応答 = MsgBox(メッセージ, スタイル, タイトル)
End Sub
'-----------------------------------------------------------------------------------------
Private Sub テストデータを作成する()
    Sheets("CSV用データ").Select
    Sheets("CSV用データ").Copy                  '新しいブックにコピーする
    Application.DisplayAlerts = False
    ActiveWorkbook.SaveAs Filename:=フルパスCSV, FileFormat:=xlCSV ', CreateBackup:=False
    ActiveWorkbook.Close
End Sub
'-----------------------------------------------------------------------------------------
Private Sub ユーザーに結果を確認してもらう()
    スタイル = 64                               'vbInformation
    メッセージ = "CSVファイルを文字列として開きました。" & Chr(13) & Chr(13) & _
                "郵便番号の前ゼロが消えずに、付いています"
    応答 = MsgBox(メッセージ, スタイル, タイトル)
End Sub
'-----------------------------------------------------------------------------------------
Sub テスト用に作ったTXTファイルを削除する()
    Application.DisplayAlerts = False
    ActiveWorkbook.SaveAs Filename:=フルパスTXT, _
        FileFormat:=xlText, CreateBackup:=False
    ActiveWorkbook.Close
    Kill 新しい名前                             'テスト用ファイルを削除する
    Worksheets("Title").Select
    Range("O17").Select                         'カーソルを定位置へ移動する
End Sub
'-----------------------------------------------------------------------------------------
Sub Auto_Close()
    Application.DisplayAlerts = False           '閉じる際に確認メッセージを出さない
    ActiveWorkbook.Close                        '現在開いているブックを閉じる
End Sub
'-----------------------------------------------------------------------------------------