'下面的代码可以把指定目录下的文件夹设为共享.(引用:别人的)Private Const NERR_SUCCESS As Long = 0&
Private Const STYPE_ALL       As Long = -1  'note: my const
Private Const STYPE_DISKTREE  As Long = 0
Private Const STYPE_PRINTQ    As Long = 1
Private Const STYPE_DEVICE    As Long = 2
Private Const STYPE_IPC       As Long = 3
Private Const STYPE_SPECIAL   As Long = &H80000000
'permissions
Private Const ACCESS_READ     As Long = &H1
Private Const ACCESS_WRITE    As Long = &H2
Private Const ACCESS_CREATE   As Long = &H4
Private Const ACCESS_EXEC     As Long = &H8
Private Const ACCESS_DELETE   As Long = &H10
Private Const ACCESS_ATRIB    As Long = &H20
Private Const ACCESS_PERM     As Long = &H40
Private Const ACCESS_ALL      As Long = ACCESS_READ Or _
                                        ACCESS_WRITE Or _
                                        ACCESS_CREATE Or _
                                        ACCESS_EXEC Or _
                                        ACCESS_DELETE Or _
                                        ACCESS_ATRIB Or _
                                        ACCESS_PERM
Private Type SHARE_INFO_2
  shi2_netname       As Long
  shi2_type          As Long
  shi2_re        As Long
  shi2_permissions   As Long
  shi2_max_uses      As Long
  shi2_current_uses  As Long
  shi2_path          As Long
  shi2_passwd        As Long
End Type
Private Declare Function NetShareAdd Lib "netapi32" _
  (ByVal servername As Long, _
   ByVal level As Long, _
   buf As Any, _
   parmerr As Long) As Long
Private Declare Function NetShareDelete Lib "netapi32()" (ByVal servername As Long, _
   ByVal level As Long, _
   buf As Any, _
   parmerr As Long) As LongPrivate Function ShareAdd(sServer As String, _
                          sSharePath As String, _
                          sShareName As String, _
                          sShareRe As String, _
                          sSharePw As String) As Long
   Dim dwServer   As Long
   Dim dwNetname  As Long
   Dim dwPath     As Long
   Dim dwRe   As Long
   Dim dwPw       As Long
   Dim parmerr    As Long
   Dim si2        As SHARE_INFO_2
   dwServer = StrPtr(sServer)
   dwNetname = StrPtr(sShareName)
   dwPath = StrPtr(sSharePath)
   If Len(sShareRe) > 0 Then
      dwRe = StrPtr(sShareRe)
   End If
   If Len(sSharePw) > 0 Then
      dwPw = StrPtr(sSharePw)
   End If
   With si2
      .shi2_netname = dwNetname
      .shi2_path = dwPath
      .shi2_re = dwRe
      .shi2_type = STYPE_DISKTREE
      .shi2_permissions = &H1 'ACCESS_READ
      .shi2_max_uses = -1
      .shi2_passwd = dwPw
   End With
   ShareAdd = NetShareAdd(dwServer, 2, si2, parmerr)
End FunctionPrivate Sub Command1_Click()
Dim fpath As String
Dim sharename As String
fpath = "e:\"
sharename = "1234"ShareAdd "", fpath, sharename, "", ""
End Sub