YasserKhalil
Well-known Member
- Joined
- Jun 24, 2010
- Messages
- 852
Hello everyone
In the following link, I have found a code that creates a folder and makes it shareable .. In the code there's a link to VBScript code that works fine, but not for VBA
The code creates a folder but it is not shareable and I think the cause is that I have to run the code as an administrator.
Any help in this topic, please
In the following link, I have found a code that creates a folder and makes it shareable .. In the code there's a link to VBScript code that works fine, but not for VBA
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 ...
exceldevelopmentplatform.blogspot.com
The code creates a folder but it is not shareable and I think the cause is that I have to run the code as an administrator.
Any help in this topic, please
VBA Code:
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