エクセルファイルの共有解除を行うExcel VBA

エクセルファイルの共有解除を行うExcel VBAをご紹介します。

エクセルファイルの共有解除を行うExcel VBAサンプルコード

現在開いているエクセルファイルの共有を解除する。

 ActiveWorkbook.ExclusiveAccess

ファイルを指定したい場合は、下記のように直接指定すればOK。

 workbooks([ファイル名]).ExclusiveAccess

共有のエクセルファイルでできないこと

• シートの削除
• アドバンスドフィルタ（フィルタの詳細設定）
• 図形やグラフの追加
• ハイパーリンクの追加
• ピポットテーブルの挿入
• その他もろもろ

個人的には、アドバンスドフィルタが使用できないのが痛い。通常のフィルタでは動作が遅いので、あえてアドバンスドフィルタを使用したい場面が多々あるからです。

そういう時には、下記のような対応を行うことが多いです。

• 一時的に共有を外して操作する。処理が終わったら共有を付け直す or 保存せずに閉じる
• ファイルをコピーし、共有を外す。処理が終わったらコピーしたファイルは削除する

この記事はお役に立てたでしょうか？
もし参考になると思っていただけたら、こちらのボタンから共有をお願いします。

ツイート

指定のフォルダの容量取得・確認を自動で行うマクロ

フォルダのサイズをVBAで取得したい

業務を行っていくうえで、フォルダのサイズを確認するということが多々発生します。主に部署で使っている共有ハードディスクの空き容量が不安になってきたときなどでしょうか。不要なフォルダは削除またはDVDなどに退避し、何とかやりくりを行っていく。そのために手動でちまちまとフォルダの容量を確認するのは、非常に面倒くさい。マクロを使用することで、自動でフォルダのサイズを取得できます。

指定のフォルダのサイズを取得する関数 サンプルコード

Private Sub write_file_size(sPath As String, lRow As Long)
'サイズの記入を行う関数
'引数：処理対象のファイル名

    Dim fso As Object
    Dim wbMain As Workbook
    Dim wsMain As Worksheet
    Dim lSize As Long
    Dim lSizeCal As Long

    Set wbMain = Workbooks(ThisWorkbook.Name)
    Set wsMain = wbMain.Worksheets("存在チェック")
        
    Set fso = CreateObject("Scripting.FileSystemObject")
    lSize = fso.GETFolder(sPath).Size
    lSizeCal = lSize / 1024
    
    If lSizeCal > 1024 Then
          wsMain.Cells(lRow, 6) = Round(lSize / 1048576, 1) & "MB"
    Else
        wsMain.Cells(lRow, 6) = Round(lSize / 1024, 1) & "KB"
    End If
    
    Set fso = Nothing    
    
End Sub

なお、下記のサンプルコードは指定したパスのフォルダサイズを取得するものです。
こちらの指定のパス以下のサブフォルダパスを取得するような関数と組み合わせて使うと良いと思います。

指定のパス以下のサブフォルダ名を取得する関数 サンプルコード

Public Sub main(sPath As String)

    Dim buf As String, msg As String
    Dim wb As Workbook
    Dim ws As Worksheet
    Dim i As Integer
    
    
    Set wb = Workbooks(sWb)
    Set ws = wb.Worksheets("Sheet1")
    
    i = 3
    buf = Dir("sPath\*.*", vbDirectory)
    Do While buf <> ""
        If InStr(buf, ".") = 0 Then
            ws.Cells(i, 2) = buf
            i = i + 1
        End If
        
        
        buf = Dir()
        
        
    Loop
    

End Sub

この記事はお役に立てたでしょうか？
もし参考になると思っていただけたら、こちらのボタンから共有をお願いします。

ツイート