Sub kyoyu()
ActiveWorkbook.UnprotectSharing
ActiveWorkbook.ExclusiveAccess
End Sub
Sub kyoyu()
ActiveWorkbook.UnprotectSharing Sharingpassword:="1234"
End Sub
Sub kyoyu()
ActiveWorkbook.ProtectSharing
End Sub
Sub kyoyu()
ActiveWorkbook.ProtectSharing Sharingpassword:="1234"
End Sub
Option Explicit
Sub imd()
'※参照設定でMicrosoft Scripting Runtimeにチェック
Dim FSO As FileSystemObject ' FSO
Set FSO = New FileSystemObject
'元の親フォルダ=dir1
Dim dir1 As String
'ダイアログボックスから元親フォルダ選択
Application.FileDialog(msoFileDialogFolderPicker).Show
dir1 = Application.FileDialog(msoFileDialogFolderPicker).SelectedItems(1) & "\"
'コピー先のFolder=dir2
Dim dir2 As String
MkDir dir1 & "after"
dir2 = dir1 & "after"
'コピー対象ファイル=tg
Dim tg As String
'個々のサブフォルダ
Dim subF As String
subF = Dir(dir1 & "\", vbDirectory)
Do While subF <> ""
If subF <> "." And subF <> ".." Then ' なんか変なのが返ってくるので無視する
'例としてサブフォルダ内のエクセルファイルを対象
tg = dir1 & subF & "\*.xls"
' FSOによるファイルコピー
FSO.copyFile tg, dir2
End If
subF = Dir()
Loop
Set FSO = Nothing
End Sub
Sub mkmkd()
Dim tDir As String 'フォルダ作成パス
Dim nDir As String '作成するフォルダ名
'このワークブックのパスを取得
tDir = ThisWorkbook.Path
'tDirに作成するフォルダ名(名称:test)
nDir = tDir & "\" & "test"
'既にnDirがあるかどうか確認
If Dir(nDir, vbDirectory) = "" Then
'ない場合は作る
MkDir nDir
'あるなら何もしない
Else: End If
End Sub
| 名前 | 説明 | 型 | 備考 |
|---|---|---|---|
| filename | ファイル名 | string | 必須 |
| overwrite | 上書き可否 | True or False |
省略可 （初期値：False) |
| unicode | ASCIIファイル or Unicodeファイル |
True or False |
省略可 （初期値：True_ASCII) |
Sub createTxt()
Dim fso As Object
Set fso = CreateObject("Scripting.FileSystemObject")
fso.createtextfile ("D:\test.txt")
Set fso = Nothing
End Sub
Sub SampleFCsd()
Dim A, B'(
'コピー元のファイル A
A = "C:\test.xlsx"
'コピー後のファイル B
B = "D:\test.xlsx"
'AをBにコピー
FileCopy A, B
End Sub
上記ではCドライブ直下にあるtest.xlsxというファイルをDドライブ直下にコピーする作業を実行しています。
| 名前 | 説明 | 備考 |
|---|---|---|
| oldpathname | 変更するファイル・フォルダ名をファイルパスを含めて指定する | 必須 |
| newpathname | 新しいファイル・フォルダ名をファイルパスを含めて指定する | 必須 |
Sub namae()
'"左" をas以降に変換
Name "C:\Document\dammy.txt" As "C:\Document\dammy.txt"
End Sub
Sub FileNameChange()
Dim FileP As String
'フォルダ選択のダイアログボックスを開く
Application.FileDialog(msoFileDialogFolderPicker).Show
'選択したフォルダのパス名を取得
FileP = Application.FileDialog(msoFileDialogFolderPicker).SelectedItems(1)
'ファイル名の変換
Dim FileA As String
'選んだフォルダの拡張子xlsを含むファイルを返す
FileA = Dir(FileP & "\*.xls*")
'フォルダ内のファイルがなくなるまで繰り返す
Do While FileA <> ""
'ファイル名の変換
Dim Str1 As String, Str2 As String
'変換前の対象文字列
Str1 = "201308" '←任意で変える部分
'変換後の文字列
Str2 = "201310" '←任意で変える部分
'各ファイルのStr1部分をStr2に変換する
Name FileP & "\" & FileA As (Replace(FileP & "\" & FileA , Str1, Str2))
'Dirの指定をなくす
FileA = Dir()
Loop
End Sub
Sub S1_ChDir()
'CurrentDirectoryを変更する
ChDir "C:\Documents and Settings"
End Sub
Private Declare Function SetCurrentDirectory Lib "kernel32" Alias "SetCurrentDirectoryA" (ByVal lpPathName As String) As Long
Sub S2_ChDir()
'変更後パスFilePathの宣言
Dim FilePath As String
'変更するファイルパスの指定
FilePath = "\\NetWork\Path01"
'変更の実行
Call SetCurrentDirectory(FilePath)
End Sub
Sub S3_ChDir()
'CurrentDirectoryを変更する
CreateObject("WScript.Shell").CurrentDirectory _
= "\\NetWork\Path01"
End Sub
Sub WoAd()
Dim wb As Workbook
Workbooks.Add
'オブジェクト型変数なので 'Set'
Set wb = ActiveWorkbook
'なんとなくセルに文字入力
wb.Sheets(1).Range("a1") = 1111
'なんとなくA1セルをmsgboxに表示
MsgBox wb.Sheets(1).Range("a1")
'保存せずに閉じる
wb.Close SaveChanges:=False
End Sub
Sub ADDD()
'パスを含めて指定する
Workbooks.Add ("C:\aaa.xls")
End Sub
| 名前 | 説明 | 備考 |
|---|---|---|
| InitialFilename | ファイル名 | 省略した場合→ 現在と同じファイル名 （変更なし） |
| FileFilter | ファイルの候補を指定する文字列 | 省略した場合→ すべてのファイル(*.*) |
| FilterIndex | FileFilterに複数指定した場合に使用 | 省略した場合→ 最初のFilter |
| Title | ダイアログボックスのタイトル | 省略した場合→ "名前を付けて保存" |
Sub SaveD1()
Dim SaF As Variant
'ファイル保存のダイアログボックス表示
SaF = Application.GetSaveAsFilename( _
InitialFileName:="TesstaaSA", _
FileFilter:="Excel 97-2003 ブック(*.xls), *.xls" _
& ",CSV(*.csv),*.csv", _
FilterIndex:=1, _
Title:="ファイル名を指定")
'キャンセルボタンを押した場合の処理
If SaF <> "False" Then
Else
Exit Sub
End If
'ファイルを保存する
'拡張子がxlsの場合
If Right(SaF, 3) = "xls" Then
ActiveWorkbook.SaveAs Filename:=SaF, FileFormat:=xlNormal
Else
'拡張子がcsvの場合
ActiveWorkbook.SaveAs Filename:=SaF, FileFormat:=xlCSV
End If
End Sub
| 名前 | 説明 | 型 | 備考 |
|---|---|---|---|
| FileName | （ファイルパス＋）ファイル名 | String | 必須 |
| FileFormat | ファイル形式（拡張子） | XlFileFormat | 既定: 開いてる 状態のまま |
| Password | 読み取りパスワードの設定 | String 15文字以内 |
既定: 設定なし |
| WriteResPassword | 書き込みパスワードの設定 | String | 既定: 設定なし |
| ReadOnlyRecommended | 読み取り専用推奨の設定 | String | 既定: 設定なし |
| CreateBackup | バックアップ ファイルの作成有無 | True or False | 既定: False |
| AccessMode | アクセス モードを指定 | XlSaveAsAccessMode | 既定: xlNoChange |
| ConflictResolution | 共有ブックが更新時 競合した場合の処理方法 |
XlSaveConflictResolution | 既定: 随時確認 |
| AddToMru | 最近使用したファイルの 一覧にブックを追加 |
True or False | 既定: False |
| TextCodePage | Excelでは使用不可 | - | - |
| TextVisualLayout | Excelでは使用不可 | - | - |
| Local | ファイルの言語設定 | True(Excel) or False(VBA) |
既定: False |
Sub SaveAs1()
'アクティブなワークブックをファイル名を指定して
'csv形式で保存する
ActiveWorkbook.SaveAs Filename:="Testfile", _
FileFormat:=xlCSV
End Sub
Sub SaveAs2()
'アクティブなワークブックをファイル名、書き込みパスワードを指定し、
'xls形式で保存する
ActiveWorkbook.SaveAs Filename:="Test2", _
FileFormat:=xlWorkbookNormal, WriteResPassword:="1234"
End Sub
Sub SampleFolderD()
'取得するフォルダ名の宣言
Dim folder1 As String
'ダイアログボックスを表示
Application.FileDialog(msoFileDialogFolderPicker).Show
'OKボタンをクリックした時のフォルダの取得
folder1 = Application.FileDialog(msoFileDialogFolderPicker).SelectedItems(1)
'フォルダ名をMsgBoxに表示
MsgBox folder1
End Sub
| 名前 | 説明 | 備考 |
|---|---|---|
| FileFilter | ファイルの候補を指定する文字列 | 省略→すべてのファイル |
| FilterIndex | FileFilterに複数指定した場合に使用 | 省略→最初のFilter |
| Title | ダイアログボックスのタイトル | 省略→"ファイルを開く" |
| ButtonText | MAC用 | 省略可 |
| MultiSelect | 複数のファイルを選択可否 | 省略→False(不可) |
Sub SampleFileOpen()
Dim fileOpen As Variant
Dim wbOpen As Workbook
fileOpen = Application.GetOpenFilename("Excel ファイル (*.xls*),*.xls*")
'キャンセルボタンを押した場合の処理
If fileOpen = "False" Then
Exit Sub
End If
'ファイルを開く
Workbooks.Open (fileOpen)
'変数に入れてみる
Set wbOpen = Workbooks(Dir(fileOpen, vbNormal))
MsgBox wbOpen.Name
End Sub
Workbooks.Open (fileOpen), ReadOnly:=True
とします。
| 名前 | 説明 | 型 | 備考 |
|---|---|---|---|
| SaveChanges | 変更を保存するかどうか | True or False | 省略可(保存するかどうかの確認メッセージが出る） |
| Filename | 変更後のファイル名 | String | 省略可(上書き保存) |
| RouteWorkbook | 回覧するかどうか | True or False | 使用不可※ |
Sub CloseSample()
Dim FN As String
'保存するファイル名を"TestFile2"とする
FN = "TestFile2"
Workbooks.Open ("C:\TestFile.xls")
'Workbookに変更を加える
Workbooks("TestFile.xls").Worksheets(1).Range("A1") = 1
'"TestFile2"に名前を変更して保存
Workbooks("TestFile.xls").Close SaveChanges:=True, Filename:=FN
End Sub
| 名前 | 説明 | 備考 |
|---|---|---|
| pathname | フォルダ名＋ファイル名 | ない場合は"" |
| attributes | ファイルの属性指定 | 省略すると標準の属性 |
Sub SampleDir()
'ファイルの有無を確認
If Dir("C:\TestFile.xls") = "" Then
'ファイルがない場合（ファイル名が返ってきていない場合）
MsgBox ("C:\TestFile.xlsはありません")
Else
'ファイルがある場合
Workbooks.Open "C:\TestFile.xls"
End If
End Sub
Sub SampleFoldDir()
Dim Folder1 As String, FileA As String, LastRow As Long
'フォルダを任意で選択する
With Application.FileDialog(msoFileDialogFolderPicker).Show
Folder1 = .SelectedItems(1)
End With
'選んだフォルダの拡張子xlsを含むファイルを返す
FileA = Dir(Folder1 & "\*.xls*")
'フォルダ内のファイルがなくなるまで繰り返す
Do While FileA <> ""
'一番上の行を取得
LastRow = Cells(Rows.Count, 1).End(xlUp).Row
'順にファイル名をセルに入力
Cells(LastRow + 1, 1) = FileA
'Dirのpathnameの指定をなくす
FileA = Dir()
Loop
End Sub
| 名前 | 説明 | 型 | 備考 |
|---|---|---|---|
| FileName | ファイルパス＋ファイル名 | String | 必須 |
| UpdateLinks | リンク更新方法 (ユーザー任意,しない,する) |
1 or 0 or 3 |
既定: 1 |
| ReadOnly | 読み取り専用かどうか | True or False | 既定: False |
| Format | txt.ファイルの場合の区切り文字 (タブ,コンマ,スペース,セミコロン,なし) |
1 or 2 or 3 or 4 or 5 | 既定: 現在値 |
| Password | 読み取りパスワードがある場合に入力可能 | 任意のパスワード | 既定: 省略 |
| WriteResPassword | 書き込みパスワードある場合に入力可能 | 任意のパスワード | 既定: 省略 |
| IgnoreReadOnly Recommended |
読み取り専用推奨時にメッセージを出さなくするか | True or False | 既定: False |
| Origin | txtファイルの場合、元のOS | xlWindowsなど | 既定: 使用OS |
| Delimiter | 引数 Format が 6 の場合の区切り文字(タブ,コンマ,セミコロン) | Chr(9) or "," or ";" | |
| Editable | Excel 4.0 のアドインの場合 | True or False | 既定: False |
| Notify | 誰かがファイル開いてる場合の通知 | True or False | 既定: False |
| Converter | ファイル コンバータのインデックス番号？ | ？？？ | 既定: ？？？ |
| AddToMru | 最近使用したファイルの一覧にブックを追加 | True or False | 既定: False |
| Local | Excel の言語設定に合わせて保存する | True or False | 既定: False |
| CorruptLoad | 読み込み処理？ | xlNormalLoad, xlRepairFile, xlExtractData |
既定: 省略 |
Sub SampleOpen1()
'[C:\]にある[TestFile.xls]を読み取り専用で、外部リンクを更新しないで開く
Workbooks.Open "C:\TestFile.xls", ReadOnly:=True, UpdateLinks:=0
End Sub
Sub SampleKill()
Dim fileA As String
fileA = "C:\TestFile.xls"
'ファイルが存在する場合は削除
If Dir(fileA) <> "" Then 'fileAが存在しなくない場合
Kill fileA
End If
End Sub
