Sunday 6 August 2017

Use VBA to make a folder shareable

So some poor guy got heavily downvoted asking, reasonably, how to use VBA to make a folder shareable. Here is the answer, I cannot post on SO because the question is on hold.

Option Explicit

Sub TestRajeshS()
    '* For Rajesh S
    '*
    '* How to make a folder shareable
    '* needs admin permissions!
    '* Answer to https://stackoverflow.com/questions/45525238/how-can-i-make-the-folder-sharable
    
    '* copyright
    '* based on https://blogs.msdn.microsoft.com/imayak/2008/12/05/vbscript-for-creating-and-sharing-a-folder/#
    '* Owner - Imayakumar J.   Date - December 5 2008
    '* end of copyright
    
    '----------------------------------------------------
    'Create folder
    '----------------------------------------------------
    
    Dim filesys As Object
    Set filesys = CreateObject("Scripting.FileSystemObject")
    
    Dim sFolderName As String
    sFolderName = "n:\ShareThis"
    
    If Not filesys.folderexists(sFolderName) Then
        filesys.createfolder sFolderName
    End If
    
    '---------------------------------------------------------
    ' Check if another shar with the same name exists
    '---------------------------------------------------------
    
    Dim strComputer As String
    strComputer = "."
    
    Dim objWMIService As Object
    Set objWMIService = GetObject("winmgmts:" _
        & "{impersonationLevel=impersonate}!\\" & strComputer & "\root\cimv2")
        
    Dim colShares As Object
    Set colShares = objWMIService.ExecQuery _
        ("Select * from Win32_Share Where Name = 'MYSHARENAME'")
    
    Dim objShare As Object
    For Each objShare In colShares
        objShare.Delete
    Next
    
    '-----------------------------------------------------
    ' Share the created folder
    '-----------------------------------------------------
    
    Const FILE_SHARE = 0
    Const MAXIMUM_CONNECTIONS = 25
    strComputer = "."
    Set objWMIService = GetObject("winmgmts:" _
        & "{impersonationLevel=impersonate}!\\" & strComputer & "\root\cimv2")
        
    Dim objNewShare As Object
    Set objNewShare = objWMIService.Get("Win32_Share")
    
    Dim errReturn As Variant
    errReturn = objNewShare.Create _
        (sFolderName, "MYSHARENAME", FILE_SHARE, _
            MAXIMUM_CONNECTIONS, "Sample share created with Microsoft Scripting Runtime.")
    
    If errReturn = "0" Then
        Debug.Print "Success"
    Else
        '* did you forget to run as admin?
        Debug.Print "Task Failed - did you forget to run as admin"
    End If
    
    '---------------------------------------------
    ' Script End
    '-------------------------------———————
    

End Sub


No comments:

Post a Comment