Excelマクロのモジュールをそのまま貼り付け。
（会社とか家とか出先とかで見るため）
「Option Compare Binary」以下を標準モジュールに貼り付ければ、Myマクロ辞典に！
貼り付け後、「■Sub 」を「Sub 」に置き換えよう！
※公開している以上、利用は自由ですが、自己責任で。


Option Compare Binary
Option Explicit
'
'エラー関連マクロ
Public ProcName As String

■Sub エラー処理テスト1()

On Error GoTo エラー処理テスト 'エラー発生時にジャンプする先

'ChDir "c:abc" 'わざとエラーを発生させる
エラー処理テスト3 'または別のプロシージャに飛んでエラーを発生させる

Exit Sub '正常終了

エラー処理テスト: 'エラー発生時の処理
'プロシージャ名を取得（→プロシージャ名の取得）
ProcName = ThisWorkbook.VBProject.VBComponents("ErrSet1").CodeModule.ProcOfLine(10, 0)
MsgBox "エラー処理テスト1" & vbNewLine & ProcName & vbNewLine & Err.Number

エラー処理テスト22

End Sub

■Sub エラーへの対策()
'「On Error GoTo」の次行以降にエラーが起こった場合は、すべてエラー処理のラベルにジャンプする。
'エラー処理のための行き先ラベルの前には「Exit Sub」を入れて、エラーがないときはエラー処理の前で終了するようにする。

On Error GoTo エラー処理 'エラー発生時にジャンプする先

ChDir "c:abc" 'わざとエラーを発生させる

Exit Sub '正常終了

エラー処理: 'エラー発生時の処理
'プロシージャ名を取得（→プロシージャ名の取得）
Dim ProcName As String
ProcName = ThisWorkbook.VBProject.VBComponents("Other").CodeModule.ProcOfLine(230, 0)
' ↑モジュール名 ↑プロシージャ内の行指定
エラーへジャンプ

MsgBox "作業を中止します。原因を取り除いてからやり直してください。　　　" & vbNewLine & vbNewLine & _
"場所：　" & ProcName & "　　　" & vbNewLine & _
"内容：　" & Error(Err) & "（" & Err.Number & "）", _
vbCritical, "エラー発生"

'Application.DisplayAlerts = False '閉じる際に確認メッセージを出さない
'Close 'ファイルをすべて閉じる
'Application.Quit 'エクセルを終了する


'Str(Err) ＝ Err.Number：エラー番号
'Error(Err) ＝　Err.Description：エラーの種類

'※親プロシージャがある場合は、親は終了しないので「End」を置く。


'★上記で「実行時エラー '1004'」が出るときは、以下の通り設定変更する。
'　1.Excelのメニューバー[ツール]－[マクロ]－[セキュリティ] をクリック。
'　2.[信頼できる発行元] タブをクリック。
'　3.[Visual Basic プロジェクトへのアクセスを信頼する]チェックボックスをオン。
'　4.[OK]をクリック。


End Sub

Function エラーへジャンプ()

MsgBox Str(Err) & "：" & Err.Description, vbCritical, "プロシージャのジャンプもＯＫ。"

End Function

■Sub プロシージャ名の取得()

Dim ProcName As String
ProcName = ThisWorkbook.VBProject.VBComponents("Other").CodeModule.ProcOfLine(30, 0)
MsgBox ProcName

'"Other"　はモジュール名（Module1など）
'CodeModule.ProcOfLine(line, prockind)
'line　…　 モジュールのプロシージャ内の行番号（プロシージャの1行目じゃなくてもよい）
'複数のプロシージャが1つのモジュールに記述されている場合は､そのモジュールの行内を指定｡
'prockind　… プロシージャの種類を表す数値。
'一般的なSubプロシージャやFunctionプロシージャを指定するときは0を指定｡

End Sub

■Sub プロシージャをダイアログに表示しない()
'メニュー［ツール］－［マクロ］－［マクロ］ダイアログに
'プロシージャ名を表示（マクロの実行）させたくない場合は、

'Function プロシージャ名() ‥本来はユーザー関数を定義するプロシージャ
'Private Sub プロシージャ名()


'プロシージャ マクロの実行 呼び出し ユーザー定義関数 戻り値
'Sub(Public Sub) 表示される すべてのモジュール 表示されない 返すことができない
'Private Sub 表示されない 同じモジュールのみ 表示されない 返すことができない
'Function 表示されない すべてのモジュール 表示される 返すことができる
'Private Function 表示されない 未確認 表示されない 返すことができる

'Friend オブジェクトモジュールでのみ使用可（デフォルト）

End Sub

Excelマクロのモジュールをそのまま貼り付け。
（会社とか家とか出先とかで見るため）
「Option Compare Binary」以下を標準モジュールに貼り付ければ、Myマクロ辞典に！
貼り付け後、「■Sub 」を「Sub 」に置き換えよう！
※公開している以上、利用は自由ですが、自己責任で。


Option Compare Binary
Option Explicit
'
'エラー関連マクロ

■Sub エラー()
'マクロ実行中にエラーが発生した場合、エラーメッセージを表示してマクロを強制終了する。

MsgBox Proc & vbNewLine & Err.Description

MsgBox "作業を中止します。原因を取り除いてからやり直してください。　　　" & vbNewLine & vbNewLine & _
"場所： " & Proc & "　　　" & vbNewLine & _
"内容： " & Err.Description & "（" & Err.Number & "）　　　", _
vbCritical, "エラー発生"


'---親プロシージャを含めて強制終了する
End


'※エラーが発生すると、プロシージャ名が報告されるので、そのプロシージャのみエラー処理を外して、
'※問題のtsvファイルを実行してエラー箇所を探す。


End Sub

■Sub エラー処理テスト2()

MsgBox "作業を中止します。原因を取り除いてからやり直してください。　　　" & vbNewLine & vbNewLine & _
"場所：　" & ProcName & "　　　" & vbNewLine & _
"内容： " & Err.Description & "（" & Err.Number & "）", _
vbCritical, "エラー発生"

End

End Sub

■Sub エラー処理テスト3()

MsgBox "作業を中止します。　　　" & vbNewLine & vbNewLine & _
"場所：　" & ProcName & "　　　" & vbNewLine & _
"内容：　" & Error(Err) & "（" & Err.Number & "）", _
vbCritical, "エラー発生"

End

End Sub

Excelマクロのモジュールをそのまま貼り付け。
（会社とか家とか出先とかで見るため）
「Option Compare Binary」以下を標準モジュールに貼り付ければ、Myマクロ辞典に！
貼り付け後、「■Sub 」を「Sub 」に置き換えよう！
※公開している以上、利用は自由ですが、自己責任で。

Excelマクロのモジュールをそのまま貼り付け。
（会社とか家とか出先とかで見るため）
「Option Compare Binary」以下を標準モジュールに貼り付ければ、Myマクロ辞典に！
貼り付け後、「■Sub 」を「Sub 」に置き換えよう！
※公開している以上、利用は自由ですが、自己責任で。


Option Compare Binary
Option Explicit
'
'ファイル操作関連

■Sub カレントフォルダの変更_その1()
'以下の2行が必要。

ChDrive ThisWorkbook.Path
ChDir ThisWorkbook.Path

'"CurDir"がカレントフォルダの意
MsgBox "現在のカレントフォルダは" & vbCr & CurDir & vbCr & "です。"

End Sub

■Sub カレントフォルダの変更_その2()

ChDrive ActiveWorkbook.Path
ChDir ActiveWorkbook.Path

MsgBox "現在のカレントフォルダは" & vbCr & CurDir & vbCr & "です。"

End Sub

■Sub カレントフォルダの変更_デスクトップに保存()

Dim Path As String, WSH As Variant
Set WSH = CreateObject("WScript.Shell")
Path = WSH.SpecialFolders("Desktop") & "\"
ActiveWorkbook.SaveAs Path & "Sample1.xls"
Set WSH = Nothing

'※「Path」を変数に使うと変な動きをするので「myPath」とかにすること。？？？
'※「Path」はプロパティ（Pathプロパティ）として使われる。

'※カレントドライブが別のドライブの場合、ChDirステートメントを実行してもカレントフォルダは変更されない｡
'※にChDriveステートメントでドライブを指定する｡
'※ChDrive "D"

'引数に指定する文字列
'定数 内容
'Desktop Desktopフォルダ
'Favorites Favoritesフォルダ
'Fonts Fontsフォルダ
'MyDocuments MyDocumentsフォルダ
'Programs Programsフォルダ
'Recent Recentフォルダ
'SendTo SendToフォルダ
'StartMenu StartMenuフォルダ
'StartUp StartUpフォルダ


End Sub

■Sub カレントフォルダの変更_マイドキュメントから開く()

'カレントフォルダの変更
Dim Path As String, WSH As Variant, openFileName As String
Set WSH = CreateObject("WScript.Shell")
Path = WSH.SpecialFolders("MyDocuments") & "\"
ChDir Path
Debug.Print Path

'ファイルを開く（GetOpenFilename FileFilter, FilterIndex, Title, ButtonText, MultiSelect）
openFileName = Application.GetOpenFilename("Excelファイル,*.xls")
If openFileName <> "False" Then
Workbooks.Open openFileName
End If
Set WSH = Nothing


End Sub

■Sub フォルダの確認()

Dim myPath, myDir As String

myPath = Range("myCurDir") '前回使用したファイルパス
myDir = Dir(myPath, vbDirectory) '前回使用したフォルダ（存在しない場合は空欄になる）

MsgBox "パス：　" & myPath & "　　　" & Chr(10) & "フォルダ名：　" & myDir


'※カレントフォルダの確認は、File　の「ファイルを取得」を参照

End Sub

■Sub フォルダの作成()

MkDir "C:\Work\新しいフォルダ"

'フォルダ名だけを指定した場合、カレントフォルダが操作の対象になる

End Sub

■Sub フォルダの削除その1()

RmDir "C:\Work\新しいフォルダ"

'フォルダにファイルが存在するとエラーになる(空のフォルダしか削除できない）

End Sub

■Sub フォルダの削除その2()

Dim FSO As Object
Set FSO = CreateObject("Scripting.FileSystemObject")
FSO.DeleteFolder "C:\Work"
Set FSO = Nothing

'C:\Work\フォルダを削除（フォルダ内の全てのファイルを削除）

End Sub

■Sub フォルダ指定_その1()

'【FileDialogオブジェクトを使う方法】
'ダイアログが開くのでフォルダを選択すると、そのフォルダがカレントフォルダになる。
'ダイアログのボタンは使えず、「保存先」のプルダウンメニューでフォルダを指定する。　←使えるみたい。。。

Dim MyFolder As String

With Application.FileDialog(msoFileDialogFolderPicker)

'.Show 以下のIF文が入らないときはこれだけでよい。

If .Show = -1 Then
MyFolder = .SelectedItems(1)
Else
'[キャンセル] をクリックした場合
End
End If

End With

MsgBox "MyFolder: " & MyFolder
MsgBox "CurDir: " & CurDir

'「ファイルパスの変更」も参照

End Sub

■Sub フォルダ指定_その2()
'【Shellを使う方法】

Dim Shell, myPath
Set Shell = CreateObject("Shell.Application")
Set myPath = Shell.BrowseForFolder(&O0, "フォルダを選んでください", &H1 + &H10, "C:\")
'Set myPath = Shell.BrowseForFolder(&O0, "フォルダを選んでください", &H1 + &H10, ThisWorkbook.path)
'↑これにすると上層のフォルダが選べない
If Not myPath Is Nothing Then MsgBox myPath.Items.Item.Path
Set Shell = Nothing
Set myPath = Nothing

'参照：http://officetanaka.net/excel/vba/tips/tips39.htm (2010/03/30)

End Sub

Excelマクロのモジュールをそのまま貼り付け。
（会社とか家とか出先とかで見るため）
「Option Compare Binary」以下を標準モジュールに貼り付ければ、Myマクロ辞典に！
貼り付け後、「■Sub 」を「Sub 」に置き換えよう！
※公開している以上、利用は自由ですが、自己責任で。


Option Compare Binary
Option Explicit
'
'ファイル関連

■Sub ファイルを取得()

'CurDir …カレントディレクトリ（フォルダ）
MsgBox "カレントディレクトリは　" & CurDir & "　です。　　　"


'Application.Path …エクセル本体のパス
MsgBox "エクセル本体のパスは　" & Application.Path & "　です。　　　"


'ThisWorkbook.FullName …コードが記述されたファイルのフルパス（ファイルパス＋ファイル名）
MsgBox "コードが記述されたファイルのフルパスは　" & ThisWorkbook.FullName & "　です。　　　"


'ThisWorkbook.Path …コードが記述されたブック（このファイル）のパス（ファイルパスのみ）
MsgBox "コードが記述されたファイルのパスは　" & ThisWorkbook.Path & "　です。　　　"


'ThisWorkbook.Name …コードが記述されたブック（このファイル）名
MsgBox "コードが記述されたファイル名は　" & ThisWorkbook.Name & "　です。　　　"


'ActiveWorkbook.FullName …現在アクティブなブックのフルパス（ファイルパス＋ファイル名）
MsgBox "現在アクティブなファイルのフルパスは　" & ActiveWorkbook.FullName & "　です。　　　" 'C:\Users\TP8204\Documents\Book1.xlsx


'ActiveWorkbook.Path …現在アクティブなファイルパス
MsgBox "現在アクティブなファイルのパスは　" & ActiveWorkbook.Path & "　です。　　　" 'C:\Users\TP8204\Documents


'ActiveWorkbook.Name '…現在アクティブなブック（このファイル）名
MsgBox "現在アクティブなファイル名は　" & ActiveWorkbook.Name & "　です。　　　" 'Book1.xlsx


'ActiveWorkbook.Name
MsgBox "拡張子を除いたファイル名は　" & Left(ActiveWorkbook.Name, InStrRev(ActiveWorkbook.Name, ".") - 1) & "　です。" 'Book1


End Sub

■Sub ファイルの存在を調べる()
'引数に指定したファイルが存在するとファイル名を返し、存在しないと空欄("")を返す

If Dir("C:\Sample\Book2.xls") <> "" Then
Workbooks.Open "C:\Sample\Book2.xlsx"
Else
MsgBox "C:\Sample\Book2.xlsx" & vbCrLf & "が存在しません"
End If

End Sub

■Sub ファイルの新規作成()

Workbooks.Add

End Sub

■Sub ファイルを開く_その1()
'必ずパスで指定

Workbooks.Open FileName:="D:\My Documents\Book1.csv"

'読み取り専用モードで開く
Workbooks.Open FileName:="c:\test.xls", ReadOnly:=True

'※変数は使えないらしい
'※ファイルを開いてから変数を割り当てる

End Sub

■Sub ファイルを開く_その2()

Dim openFilePath As String

'ダイアログボックスが開いて、ファイルを指定する（だけ）※buttontextはMacのみ指定可
openFilePath = Application.GetOpenFilename("Microsoft Excelファイル,*.xls", Title:="ファイルを選択", buttontext:="")

'指定してファイル（パス）を開く
Workbooks.Open openFilePath


'◆拡張子の複数指定
'　×"Microsoft Excelファイル,*.xls?"　　 …xls、xlsm、xlsxなど（ダメみたい）
'　"ファイル,*.xls ; *.txt" …いろいろな拡張子1
'　"excelファイル,*.xls, wordファイル,*.doc, テキスト,*.txt" …いろいろな拡張子2

End Sub

■Sub ファイルを開くダイアログボックスを表示()

Dim openFilePath As String
Dim openFileName As String

ファイルを開く: '選択ファイルが適切でない場合に戻ってくる（→▲）

'---ダイアログを表示（ラベル）
openFilePath = Application.GetOpenFilename(FileFilter:="テキスト ファイル (*.csv),*.csv", _
Title:="のCSVファイルを選択してください。", buttontext:="") 'buttontextはMacのみ指定可

'---ファイル名をを取得（パスから分離）
openFileName = Mid(openFilePath, InStrRev(openFilePath, "\") + 1, 20)

'---ファイル名をチェック
'キャンセルが押下された
If openFilePath = "False" Then
MsgBox "ファイルが選択されていないか、見つかりませんでした。　　　", vbOKOnly + vbCritical, "エラー"
End
'CSVファイルでない　→　ファイル選択に戻る
ElseIf Right(openFilePath, 4) <> ".csv" Then
MsgBox "選択されたのはCSVファイルではありません。　　　" & vbNewLine & _
"CSVファイルを選択してください。　　　", vbExclamation, "ファイルエラー"
GoTo ファイルを開く '▲
'正常動作（ファイルの取り込み開始）
Else
If vbOK = MsgBox(openFileName & " を取り込みます。　　　", vbOKCancel + vbInformation, "ファイルを開く") Then
Workbooks.Open FileName:=(openFileName)
Else
MsgBox "処理はキャンセルされました。　　　", vbCritical, "中止"
End
End If
End If

End Sub

■Sub ファイルコピー()

FileCopy "C:\Work\Sample.txt", "D:\Tmp\Test.txt"

'コピー元ファイル名に存在しないパスや、存在しないファイル名を指定するとエラーになる。
'コピー先フォルダに同じ名前のファイルが存在するときは上書きされる。

End Sub

■Sub ファイル名の変更()

Name "C:\Work\ABC.txt" As "C:\Work\abc.txt"

End Sub

■Sub ファイル移動()

Name "C:\Work\Sample.txt" As "C:\Home\Sample.txt"

'※Nameステートメント（ファイル名の変更）でパスと変更、名前を同じにすると、結果的に移動になる。

End Sub

■Sub ファイル保存_その1()

ActiveWorkbook.Save '上書き保存（一度も保存していない場合は新規保存になる）
ActiveWorkbook.SaveAs FileName:=("新規ファイル名"), FileFormat:=xlWorkbookNormal '新規保存（Excel97-2003の互換ブック）：ファイル名を指定する
ActiveWorkbook.SaveCopyAs FileName:=("コピーファイル名"), FileFormat:=56 'コピーを保存（Excel97-2003の互換ブック）

'※利用しているExcelのﾌｧｲﾙ形式（xls,xlaxなど）以外で保存する場合にFileFormatを省略すると、ﾌｧｲﾙが壊れるので必ずつける。
'※FileFormatを指定した場合は、特別な場合を除いてファイル名に拡張子はいらない。

'保存するﾌｧｲﾙ形式（一例） FileFormat値
'Excel97-2003の互換ブック xlExcel8, 56, xlWorkbookNormal, -4143
'利用しているExcelの標準ﾌｧｲﾙ形式 xlWorkbookDefault, 51
'csv xlCSV, 6

'※ヘルプ→Microsoft Visual Basic for Applications ヘルプ→「XlFileFormat 列挙」で検索
'※バージョン参照：Other→「Excelのバージョンを取得」「ファイルフォーマットを取得」

End Sub

■Sub ファイル保存_その2()

'名前をつけて保存ダイアログが開く
'ダイアログのボタンは使えず、「保存先」のプルダウンメニューでフォルダを指定する。
'［保存］ボタンをクリックすると入力したファイル名で保存される。
'デフォルトフォルダも指定したフォルダに変更される。

Dim ns As Workbook
Dim msg As String

Set ns = ActiveWorkbook

msg = IIf(Application.Dialogs(xlDialogSaveAs).Show(arg1:="Sheet1.xls", arg2:=1), "保存", "キャンセル") '※
'ns.Close (False)

Set ns = Nothing

MsgBox msg & "しました。"
MsgBox CurDir


'組み込みダイアログボックス
'名前を付けて保存
'Application.Dialogs(xlDialogSaveAs).Show arg1:="Sheet1.xls", arg2:=43

'arg引数 解説 例
'1 ファイル名 Sheet1.xls
'2 ファイルの種類 1:Excelﾌｧｲﾙ、3:TXTﾌｧｲﾙ、6:CSVﾌｧｲﾙ（ヘルプ→「XlFileFormat 列挙」で検索）
'3 読み取りパスワード TRUE/FALSE　←未確認
'4 バックアップファイルを作成 TRUE/FALSE　←未確認
'5 書き込みパスワード 1234
'6 読み取り専用を推奨 TRUE/FALSE　←未確認


'「ファイル保存_その1」の文末の「※」参照

End Sub

■Sub ファイルを開いて保存()

Dim f_path As String 'このマクロファイルのあるパス
Dim f_name As String '保存するファイル名
Dim s_path As String 'ダイアログボックスで表示するフォルダと保存ファイル名
Dim mt As String 'ダイアログボックスのタイトル

f_path = ThisWorkbook.Path
f_name = Format(Date, "YYYYMMDD") & "1.xls"
s_path = f_path & "\" & f_name
mt = "保存するフォルダを選択して保存"

'---保存ダイアログを表示（保存するフルパスを取得）
ファイルを開く:
Dim saveFilePath As String
saveFilePath = Application.GetSaveAsFilename(InitialFileName:=s_path, FileFilter:="Excel File (*.xls),*.xls", Title:=mt)

'---ファイルを保存する
If saveFilePath = "False" Then 'キャンセルが押下された
MsgBox "キャンセルされました。　　　" & vbNewLine & f_name & "は保存できませんでした。　　　", vbOKOnly + vbCritical, "エラー"
End
Else
ThisWorkbook.SaveAs saveFilePath
MsgBox f_name & "を保存しました。　　　", vbInformation, "完了"
End If

'---カレントフォルダが変更された。以後このフォルダに保存される。
Debug.Print CurDir

End Sub

■Sub ファイル指定()

Workbooks("ID.xls").Activate

'保存されていないファイルは拡張子なしで選択。（またはファイル名を変数に代入）
Workbooks("Book1").Activate

End Sub

■Sub ファイル名を取得()

Dim FileName As String
Dim ext As String

FileName = "D:\My Documents\ABC.xls"
MsgBox FileName, vbInformation, "フルパス"


'フルパスからファイル名を除いたパスを取り出す（左端から「\」を検索）
FileName = "D:\My Documents\ABC.xls"
FileName = Left(FileName, InStrRev(FileName, "\") - 1)

MsgBox FileName, vbInformation, "パス"

'ファイル名を取得、または開いた後なら下記でＯＫ
'MsgBox CurDir, vbInformation, "パス"


'フルパスからファイル名を取り出す（右端から「\」を検索）
FileName = "D:\My Documents\ABC.xls"
FileName = Mid(FileName, InStrRev(FileName, "\") + 1, 50)

MsgBox FileName, vbInformation, "選択されたファイル名"


'ファイル名から拡張子を除いたファイル名を取り出す（左端から「.」を検索）
FileName = "ABC.xls"
FileName = Left(FileName, InStr(FileName, ".") - 1)

MsgBox FileName, vbInformation, "拡張子抜きのファイル名"


'フルパスから拡張子を取り出す
FileName = "D:\My Documents\ABC.xls"
ext = Right(FileName, 4)

MsgBox ext, vbInformation, "拡張子"

End Sub

■Sub ファイル読込_その1()

Dim mtle As String 'ダイアログボックスのタイトル
Dim mbtn As String 'ダイアログボックスのボタン（Macのみ指定可）
Dim xbottom As Long '選択範囲の最下行値（コピー元）
'Dim xlower As Long '選択範囲の最下行値（コピー先）←Publicで指定済み


'If vbOK = MsgBox(f_type & "ファイルの取り込みを開始します。　　　" & vbNewLine & "CSVファイルを選択してください。　　　", _
' vbOKCancel + vbQuestion, "CSVファイルの取り込み") Then

'---カレントフォルダの変更（下記『ファイルを開く:』で現在のフォルダをデフォルトで表示させるため。後で必ず元に戻すこと。）
ChDrive ThisWorkbook.Path
ChDir ThisWorkbook.Path

'---カレントフォルダ（現在のファイルパス）を取得（このパスに完成ファイルを保存）
f_path = CurDir
Debug.Print f_path

'---ダイアログの内容を指定
mtle = f_type & "のCSVファイルを選択してください。"
mbtn = "" 'Macのみ指定可

'---ダイアログを表示（ラベル）
ファイルを開く:
f_name = Application.GetOpenFilename(FileFilter:="テキスト ファイル (*.csv),*.csv", Title:=mtle, buttontext:=mbtn)

'---ファイル名を取得
f_name = Mid(f_name, InStrRev(f_name, "\") + 1, 20)
'MsgBox f_name, vbInformation, "選択されたファイル"

'---ファイルを開く
If f_name = "False" Then 'キャンセルが押下された
MsgBox "ファイルが選択されていないか、見つかりませんでした。　　　", vbOKOnly + vbCritical, "エラー"
End
ElseIf Right(f_name, 4) <> ".csv" Then 'CSVファイルでない　→　ファイル選択に戻る
MsgBox "選択されたのはCSVファイルではありません。　　　" & vbNewLine & _
"CSVファイルを選択してください。　　　", vbExclamation, "ファイルエラー"
GoTo ファイルを開く
Else
If vbOK = MsgBox(f_type & "ファイル " & f_name & " を取り込みます。　　　", vbOKCancel + vbInformation, "ファイルを開く") Then
Workbooks.Open FileName:=(f_name)
Else
MsgBox "処理はキャンセルされました。　　　", vbCritical, "中止"
End
End If
End If


'---貼り付けシートにコピー
Windows(f_name).Activate
xbottom = Range(Cells(1, 3), Cells(1, 3)).End(xlDown).Row 'コピー元の最下行検出
Range(Cells(1, 1), Cells(xbottom, 13)).Select '検出した範囲を選択
'Cells.Select
Selection.Copy

Workbooks("OSリスト_2009.xls").Worksheets("貼り付けシート").Activate
'Application.Goto Workbooks("OSリスト_2009.xls").Sheets("form_sheet").Range("A1")

xlower = Range(Cells(1, 3), Cells(1, 3)).End(xlDown).Row 'コピー先の最下行検出
If xlower >= 65536 Then
xlower = 1 '最下行が最下段セルなら1
Else
xlower = xlower + 1 '最下行の次行を選択
End If
'ActiveSheet.Cells(xdown, 1).Paste '×
Cells(xlower, 1).Select
ActiveSheet.Paste

'---列Aに研修タイプを入力
Range(Cells(xlower, 1), Cells(xlower + xbottom - 1, 1)).Value = f_type

'---CSVファイルを閉じる
Excel.Application.CutCopyMode = False 'クリップボードを空にする
Workbooks(f_name).Close SaveChanges:=False


End Sub

■Sub ファイル読込_その2()
'上記「ファイルを取り込む2」のINマクロ

Dim mtle As String 'ダイアログボックスのタイトル
Dim mbtn As String 'ダイアログボックスのボタン（Macのみ指定可）
Dim xbottom As Long '選択範囲の最下行値（コピー元）
'Dim xlower As Long '選択範囲の最下行値（コピー先）←Publicで指定済み


'If vbOK = MsgBox(f_type & "ファイルの取り込みを開始します。　　　" & vbNewLine & "CSVファイルを選択してください。　　　", _
' vbOKCancel + vbQuestion, "CSVファイルの取り込み") Then

'---カレントフォルダの変更（下記『ファイルを開く:』で現在のフォルダをデフォルトで表示させるため。後で必ず元に戻すこと。）
ChDrive ThisWorkbook.Path
ChDir ThisWorkbook.Path

'---カレントフォルダ（現在のファイルパス）を取得（このパスに完成ファイルを保存）
f_path = CurDir
Debug.Print f_path

'---ダイアログの内容を指定
mtle = f_type & "のCSVファイルを選択してください。"
mbtn = "" 'Macのみ指定可

'---ダイアログを表示（ラベル）
ファイルを開く:
f_name = Application.GetOpenFilename(FileFilter:="テキスト ファイル (*.csv),*.csv", Title:=mtle, buttontext:=mbtn)

'---フルパスからファイル名を取得
f_name = Mid(f_name, InStrRev(f_name, "\") + 1, 20)
'MsgBox f_name, vbInformation, "選択されたファイル"

'---ファイルを開く
If f_name = "False" Then 'キャンセルが押下された
MsgBox "ファイルが選択されていないか、見つかりませんでした。　　　", vbOKOnly + vbCritical, "エラー"
End
ElseIf Right(f_name, 4) <> ".csv" Then 'CSVファイルでない　→　ファイル選択に戻る
MsgBox "選択されたのはCSVファイルではありません。　　　" & vbNewLine & _
"CSVファイルを選択してください。　　　", vbExclamation, "ファイルエラー"
GoTo ファイルを開く
Else
If vbOK = MsgBox(f_type & "ファイル " & f_name & " を取り込みます。　　　", vbOKCancel + vbInformation, "ファイルを開く") Then
Workbooks.Open FileName:=(f_name)
Else
MsgBox "処理はキャンセルされました。　　　", vbCritical, "中止"
End
End If
End If

End Sub

■Sub ファイルを閉じる()

'CSVファイルを閉じる
Workbooks("Book1").Close

'ワークファイル"Book1"を保存して閉じる（新規の場合はダイアログボックスが表示）
Workbooks("Book1").Close SaveChanges:=True

'ワークファイル"Book1.xls"を保存しないで閉じる
Workbooks("Book1").Close SaveChanges:=False

'ワークファイル"Book1.xls"をファイル名"Book2.xls"に変更して閉じる
Workbooks("Book1").Close SaveChanges:=True, FileName:="Book2"

End Sub

■Sub ファイルを閉じるときにマクロを実行する()

'Other＞ファイルを閉じる時にマクロを実行する(Auto_Close)　参照

End Sub

■Sub ファイルを削除()

Kill "D:\Tmp\Test.txt"

End Sub

■Sub アプリケーションを閉じる()
'Excelを閉じる

'（１）‥× Excelは閉じない
End 'マクロの終了
Application.Quit 'Excelの終了

'（２）‥○ マクロが終了して、Excelが閉じる
Application.Quit 'Excelの終了
End 'マクロの終了

'【解説】
'アプリケーションを閉じてもマクロは終了しない。
'でもマクロを終了させると、次行以降のコード（Application.Quit）が実行されない。
'「Application.Quit」が読み込まれても、次行以降のマクロも実行されるようになっている。
'ので、（２）が正しい。

End Sub