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

NAME:

MAIL:

URL:

COLOR:
Black LimeGreen SeaGreen Teal FireBrick Tomato IndianRed BurlyWood SlateGray DarkSlateBlue LightPink DeepPink DarkOrange Gold DimGray Silver
SUBJECT:

COMMENT:


PASS: