打开电脑“控制面板”，点击“网络和Internet选项”，选择“网络和共享中心”。
点击“更改高级共享设置”，选择“启用文件和打印机共享”。
点击“启用网络发现”，设置好以后，点击“保存更改”。
文件夹共享设置
1、打开电脑，在电脑里找到需要共享的文件夹，鼠标右击选择“属性”；如下图
2、选择后，会弹出文件夹属性小窗口，在小窗口上方有个“共享”直接点击；如下图
3、然后在打开的共享选项窗口界面中，选择点击“共享”；如下图
4、在共享界面选择用户，电脑默认会是系统高级用户，可以新建用户给予不同操作权限，选择好后点击下方“共享”；如下图
5、选择后，电脑系统会对文件夹开通共享，生成共享访问地址路径，我们选择复制路径后，就可以把分享给其它同事访问。如下图
这里大家需要注意，如果共享文件的电脑关机后，由于电脑网卡和硬盘都是不工作状态，所以会导致，其他用户电脑无法找到共享文件的IP地址，也就无法访问共享的文件夹了。
如果文件需要长期共享的话，可以找公司运维同事，把共享的文件上创建在服务器上，服务器一般是长期运行的，就不会导致其他同事电脑无法正常访问共享文件了。
访问的时候可以 开始--运行 \\192.168.0.11
输入共享文件夹电脑系统登录用户名administrator 密码
就可以访问了，两种方式一个IP地址访问，一个计算机名字访问。
也可以点击网络里面对方电脑计算机名字访问
不是一个网段的也可以访问，只要对方开启了文件共享功能，局域网内三层交换机ping通
win10的文件夹设置

关于怎样用vb程序对win2000和win2003下NTFS格式的磁盘上的文件及文件夹进行用户权限操作，在论坛上发贴和在msdn搜到程序在对权限操作的时候都出现问题：
在文件夹使用继承属性时，用程序设置过文件夹的权限后，打开文件夹的"属性-》安全"标签的时候提示“XXXX 上的权限顺序不正确，可能导致某些数据无法作用。请按“确定”以继续并将权限正确排序，或按“取消”来复位权限。”
在在文件夹不是使用继承属性时，设置后权限正常！
问题一直未解决希望各位能指教，谢谢！
论坛帖子地址：http://community.csdn.net/Expert/topic/5685/5685970.xml?temp=.499798
　　　　　　　http://community.csdn.net/Expert/topic/5726/5726633.xml?temp=.5362818

程序如下：

 

            
Option Explicit
            
Private Const FOLDER_PATH = "f:/Test"
            
' Success status of high level access control APIs
Private Const ERROR_SUCCESS = 0&
            
' Type of Securable Object we are operating in this sample code
Private Const SE_FILE_OBJECT = 1&
Const KEY_ALL_ACCESS = KEY_QUERY_VALUE + KEY_SET_VALUE + KEY_CREATE_SUB_KEY + KEY_ENUMERATE_SUB_KEYS + KEY_NOTIFY + KEY_CREATE_LINK + READ_CONTROL
' The Security Information constants required
Private Const DACL_SECURITY_INFORMATION = 4&
Private Const SET_ACCESS = 2&
            
Private Enum SE_OBJECT_TYPE
SE_UNKNOWN_OBJECT_TYPE = 0&
SE_FILE_OBJECT = 1&
SE_SERVICE = 2&
SE_PRINTER = 3&
SE_REGISTRY_KEY = 4&
SE_LMSHARE = 5&
SE_KERNEL_OBJECT = 6&
SE_WINDOW_OBJECT = 7&
End Enum
' Standard access rights extracted from WinNT.h
Private Const SYNCHRONIZE = &H100000
Private Const READ_CONTROL = &H20000
Private Const WRITE_DAC = &H40000
Private Const WRITE_OWNER = &H80000
Private Const STANDARD_RIGHTS_READ = (READ_CONTROL)
Private Const STANDARD_RIGHTS_WRITE = (READ_CONTROL)
Private Const DELETE = &H10000
            
' Generic access rights extracted from WinNT.h
Private Const GENERIC_ALL = &H10000000
Private Const GENERIC_EXECUTE = &H20000000
Private Const GENERIC_READ = &H80000000
Private Const GENERIC_WRITE = &H40000000
            
' Inheritance Flags
Private Const CONTAINER_INHERIT_ACE = &H2
Private Const OBJECT_INHERIT_ACE = &H1
            
' The TRUSTEE structure identifies the user account, group account, or logon session
' to which an ACE applies. The structure can use a name or a security identifier (SID)
' to identify the trustee.
            
' Access control APIs, such as SetEntriesInAcl and GetExplicitEntriesFromAcl, use this
' structure to identify the account associated with the access-control or audit-control
' information in an EXPLICIT_ACCESS structure.
Private Type TRUSTEE
    pMultipleTrustee As Long
    MultipleTrusteeOperation As Long
    TrusteeForm As Long
    TrusteeType As Long
    ptstrName As String
End Type
            
' EXPLICIT_ACCESS structure that specifies access-control information for a specified
' trustee such as access mask as well as inheritance flags
Private Type EXPLICIT_ACCESS
    grfAccessPermissions As Long
    grfAccessMode As Long
    grfInheritance As Long
    pTRUSTEE As TRUSTEE
End Type
            
' High Level access control API declarations
Private Declare Sub BuildExplicitAccessWithName Lib "Advapi32.dll" Alias _
    "BuildExplicitAccessWithNameA" _
    (ea As Any, _
    ByVal TrusteeName As String, _
    ByVal AccessPermissions As Long, _
    ByVal AccessMode As Integer, _
    ByVal Inheritance As Long)
    
Private Declare Function SetEntriesInAcl Lib "Advapi32.dll" Alias _
    "SetEntriesInAclA" _
    (ByVal CountofExplicitEntries As Long, _
    ea As Any, _
    ByVal OldAcl As Long, _
    NewAcl As Long) As Long
            
Private Declare Function GetNamedSecurityInfo Lib "Advapi32.dll" Alias _
    "GetNamedSecurityInfoA" _
    (ByVal ObjName As String, _
    ByVal SE_OBJECT_TYPE As Long, _
    ByVal SecInfo As Long, _
    ByVal pSid As Long, _
    ByVal pSidGroup As Long, _
    pDacl As Long, _
    ByVal pSacl As Long, _
    pSecurityDescriptor As Long) As Long
    
Private Declare Function SetNamedSecurityInfo Lib "Advapi32.dll" Alias _
    "SetNamedSecurityInfoA" _
    (ByVal ObjName As String, _
    ByVal SE_OBJECT As Long, _
    ByVal SecInfo As Long, _
    ByVal pSid As Long, _
    ByVal pSidGroup As Long, _
    ByVal pDacl As Long, _
    ByVal pSacl As Long) As Long
            
Private Declare Function LocalFree Lib "kernel32" (ByVal hMem As Long) As Long
            
Private Sub Command1_Click()
            
Dim result As Long
Dim pSecDesc As Long
Dim ea As EXPLICIT_ACCESS
Dim pNewDACL As Long
Dim pOldDACL As Long
 
' Get the DACL information of the folder using GetNamedSecurityInfo() API.
' SE_FILE_OBJECT constant says that the named securable object is a file or folder
result = GetNamedSecurityInfo(FOLDER_PATH, SE_FILE_OBJECT, DACL_SECURITY_INFORMATION, 0&, 0&, pOldDACL, 0&, pSecDesc)
If result = ERROR_SUCCESS Then
    
    ' Construct an EXPLICIT_ACCESS structure for Everyone with GENERIC_ALL access that will apply for c:/test1
    ' as well as subfolder and files using BuildExplicitAccessWithName() API
    BuildExplicitAccessWithName ea, "EVERYONE", GENERIC_ALL, SET_ACCESS, CONTAINER_INHERIT_ACE Or OBJECT_INHERIT_ACE
    
    ' Merge constructed EXPLICIT_ACCESS structure to the existing DACL and get an updated DACL in memory from
    ' SetEntriesInAcl() API
    result = SetEntriesInAcl(1, ea, pOldDACL, pNewDACL)
    If result = ERROR_SUCCESS Then
        MsgBox "SetEntriesInAcl succeeded"
        
        ' Call SetNamedSecurityInfo() API with the updated DACL in memory to change the DACL of c:/test folder
        result = SetNamedSecurityInfo(FOLDER_PATH, SE_FILE_OBJECT, DACL_SECURITY_INFORMATION, 0&, 0&, pNewDACL, 0&)
        If result = ERROR_SUCCESS Then
            MsgBox "SetNamedSecurityInfo succeeded"
        Else
            MsgBox "SetNamedSecurityInfo failed with error code : " & result
        End If
        
        ' Free the memory allocated for the new DACL by the SetEntriesInAcl() API, using LocalFree() API
        LocalFree pNewDACL
    Else
        MsgBox "SetEntriesInAcl failed with error code : " & result
    End If
    
    ' Free the memory allocated for the security descriptor by the GetNamedSecurityInfo() API, using LocalFree() API
    LocalFree pSecDesc
Else
    MsgBox "GetNamedSecurityInfo failed with error code : " & result
End If
End Sub
            
        

我们在使用Excel VBA进行处理数据时，或多或少会涉及到如何操作文件和文件夹。本节将重点讲述如何新建、打开、删除、复制、移动和重命名文件和文件夹操作等。

对于文件和文件夹操作，我们一般通过下面方法：
。VB命令
。EXCEL对象
。引用其他动态库对象
。API函数

在这里，我们尽可能通过不同的方法来展示如何操作文件和文件夹。注意，这里所涉及的文件一般以Excel为主。

对于如何运用文件之间的处理，如，文本文件、WORD、ACCESS和PPT与EXCEL之间的互访与查询，我们将在下节中讲解。

在本节开始之前，我们需要预备的知识点：
1、如何引用动态工程库。
打开VBE-工具-引用
选择Microsoft Scripting Runtime动态库
下面我们将会频繁用到Scripting.FileSystemObject对象来操作文件和文件夹。
另，此scrrun.dll动态库还包含了Scripting.Dictionary字典对象。

2、前期绑定和后期绑定
我们知道，VB是面向对象化编程，MS提供很多的DLL动态链接库，通过这些对象，我们可以轻松地完成任务。我们可以通过前期绑定或后期绑定来引用DLL库。

1）前期绑定。如同我们在上面用手动引用动态工程库方式，在编译代码前，我们就完成了的绑定。绑定之后，写入下面代码，创建和引用对象：

Sub BandObject()

Dim fso As Scripting.FileSystemObject
 

Set fso = New Scripting.FileSystemObject
DIM FSO NEW Scripting.FileSystemObject
 

End Sub
2）后期绑定。使用CreateObject函数，绑定某一个对象。此时，我们只有在程序运行时，绑定才有效，如，
Sub CrtObject()

Dim ObjFso As Object

Set ObjFso = CreateObject("Scripting.FileSystemObject")
 

End Sub
3、小结：
1）、前期和后期绑定区别在于定义方式和创建方式不同。
2）、前期绑定的优势在于，可以使用自动列出成员方式，查看对象的方法和属性；而后期绑定无法使用。
3）、小心后期绑定的写法。不是所有的后期绑定都是和前期绑定的对象写法一致。如，对象库：Microsoft Shell Controls And Automation
前期绑定：

Dim oShell As Shell32.Shell

Set oShell = New Shell32.Shell

后期绑定：

Dim oShell As Object

Set oShell = CreateObject("Shell.Application")
一、文件操作

1、新建Excel文件

Excel对象：Add方法：
Sub AddWorkBook()

Dim wb As Workbook

Set wb = Workbooks.Add

 


End Sub

Sub AddFile()

Dim wb As Workbook

Set wb = Workbooks.Add

wb.SaveAs ThisWorkbook.Path & "/Temp.xls"

wb.Close

Set wb = Nothing
End Sub



2、打开文件

1）、EXCEL对象：Open方法
直接打开一个工作簿。
expression.Open(FileName, UpdateLinks, ReadOnly, Format, Password, WriteResPassword, IgnoreReadOnlyRecommended, Origin, Delimiter, Editable, Notify, Converter, AddToMru, Local, CorruptLoad, OpenConflictDocument)

 Sub OpenWorkbook()

Dim wb As Workbook

Dim strWb As String



strWb = ThisWorkbook.Path & "/Temp.xls"

Set wb = Workbooks.Open(strWb)

 


End Sub

Sub OpenWorkbook2()

Dim wb As Workbook

Dim strWb As String



strWb = ThisWorkbook.Path & "/Temp.xls"

Set wb = Workbooks.Open(strWb, UpdateLinks:=False)
End Sub




2）、Excel对象：OpenText

Sub OpenText()
Dim strFile As String
Dim i As Long


strFile = ThisWorkbook.Path


With Application.FileSearch

Application.DefaultWebOptions.LoadPictures = False

.LookIn = strFile

.Filename = "*.html"

.Execute

If .Execute() > 0 Then

For i = 1 To .FoundFiles.Count

Workbooks.OpenText .FoundFiles(i)

Next

End If

Application.DefaultWebOptions.LoadPictures = True

End With
End Sub

3）、Office对象：FileDialog
通过浏览方式打开文件

Sub OpenFile_FileDialog()

Dim fd As FileDialog

Dim FFs As FileDialogFilters

Dim vaItem As Variant

Dim myWb As Workbook



Set fd = Application.FileDialog(msoFileDialogOpen)

With fd

Set FFs = .Filters

With FFs

.Clear

.Add "Excel文件", "*.xls;*.xla"

End With

.AllowMultiSelect = True

If .Show = -1 Then

For Each vaItem In .SelectedItems

Set myWb = Workbooks.Open(vaItem)

Next vaItem

End If

End With
End Sub

4）、API函数方式
打开所有类型的文件

 Const SW_SHOW = 5
Private Declare Function ShellExecute Lib "shell32.dll" Alias _

"ShellExecuteA" (ByVal hwnd As Long, ByVal lpOperation As String, _

ByVal lpFile As String, ByVal lpParameters As String, _

ByVal lpDirectory As String, ByVal nShowCmd As Long) As Long

Sub OpenFiles()

Dim varFName As Variant

Dim fn As Variant



'Excel档由Excel开,其它文档由ShellExecute函数开



varFName = Application.GetOpenFilename(, , "开启文档", MultiSelect:=True)

If IsArray(varFName) Then

For Each fn In varFName

If LCase(Right(fn, 3)) <> "xls" Then

ShellExecute 0, "open", fn, "", "", SW_SHOW

Else

Workbooks.Open (fn)


End If

Next

End If
End Sub

1、保存文件

1）、Excel对象：Save
Sub SaveWorkbook()

ThisWorkbook.Save

End Sub

2）、Excel对象：SaveAs
Sub SaveAsWorkbook()

Dim strFileName As String

strFileName = ThisWorkbook.Path & "/test.xls"

On Error Resume Next

ThisWorkbook.SaveAs strFileName
End Sub

3）、Excel对象：SaveCopyAs
Sub SaveCopyAsWorkbook()

Dim strFileName As String

strFileName = ThisWorkbook.Path & "/test.xls"

On Error Resume Next

ThisWorkbook.SaveCopyAs strFileName
End Sub

2、判断文件夹是否存在
1）、VB命令：Dir()
Sub FileExist_Dir()
Dim strFile As String

strFile = ThisWorkbook.Path & "/test.xls"

If Dir(strFile) = "" Then

MsgBox strFile & " does not Exists"

Else

MsgBox strFile & " Exist"

End If
End Sub

2）、FileSystemObject对象：FileExists方法
Sub FileExist_Fso()

Dim fso As FileSystemObject

Dim strFile As String



strFile = ThisWorkbook.Path & "/test.xls"

Set fso = New FileSystemObject

If fso.FileExists(strFile) Then

MsgBox strFile & " Exist"

Else

MsgBox strFile & " does not Exists"

End If
End Sub
 
1、建立文件的桌面快捷方式

WScript 对象：CreateShortCut方法
Sub DesktopShortCut()
Dim WSHShell As Object
Dim MyShortcut As Object
Dim DesktopPath As String


Set WSHShell = CreateObject("WScript.Shell")

DesktopPath = WSHShell.SpecialFolders("Desktop")

Set MyShortcut = WSHShell.CreateShortcut(DesktopPath & "/" & _

ThisWorkbook.Name & ".lnk")

With MyShortcut

.TargetPath = ThisWorkbook.FullName

.Save

End With


Set WSHShell = Nothing

MsgBox "已经在桌面生成快捷方式."
End Sub

2、移动文件

1）、FileSystemObject对象：MoveFilet
Sub MoveFile_fso()

Dim fso As New FileSystemObject

Dim strSourceFile As String

Dim strDestination As String

strSourceFile = ThisWorkbook.Path & "/Temp.xls"

strDestination = ThisWorkbook.Path & "/MoveFile/Temp.xls"

If Not fso.FileExists(strSourceFile) Then

MsgBox "File does not Exists.", vbCritical

Else

fso.MoveFile strSourceFile, strDestination

MsgBox "File Move to " & strDestination

End If

Set fso = Nothing
End Sub

2）、Office对象：Name
Sub MoveFile()

Dim fso As New FileSystemObject

Dim strSourceFile As String

Dim strDestination As String

On Error GoTo ErrHandle

strSourceFile = ThisWorkbook.Path & "/Temp.xls"
strDestination = ThisWorkbook.Path & "/MoveFile/Temp.xls"
dir(strSourceFile)=””?

Name strSourceFile As strDestination

Exit Sub
ErrHandle:

MsgBox Err.Description, vbCritical
End Sub
1、复制文件

1）、Office对象：FileCopy
Sub CopyFile()

Dim strSfile As String

Dim strDfile As String

strSfile = ThisWorkbook.Path & "/Temp.xls"

strDfile = ThisWorkbook.Path & "/Temp/Temp.xls"

FileCopy strSfile, strDfile


End Sub


2）、FileSystemObject对象：CopyFile

Sub CopyFile_fso()

Dim strSfile As String

Dim strDfile As String

Dim fso As New FileSystemObject

strSfile = ThisWorkbook.Path & "/Temp.xls"

strDfile = ThisWorkbook.Path & "/Temp/Temp.xls"

fso.CopyFile strSfile, strDfile

Set fso = Nothing
End Sub

2、关闭文件
Excel对象：Close方法
Sub CloseWorkbook()

ThisWorkbook.Close False

End Sub
 
1、文件重命名
Office对象：Name
Public oldNames() As String, newNames() As String

Sub ReNameFiles()

Dim i As Integer, iCount As Integer

Dim Oldname As String, Newname As String

Dim strExName As String, strPath As String


strExName = ".jpg"

strPath = ThisWorkbook.Path & "/Rename Pic/"

With Application.FileSearch

.NewSearch

.LookIn = strPath

.SearchSubFolders = False

.Filename = "*" & strExName

.MatchTextExactly = True


.FileType = msoFileTypeAllFiles

On Error GoTo ErrH

If .Execute() > 0 Then

iCount = .FoundFiles.Count

MsgBox "There were " & iCount & " file(s) found.", 0 + 64, "系统"

ReDim oldNames(iCount)

ReDim newNames(iCount)

For i = 1 To iCount

Newname = i & strExName

newNames(i) = CStr(strPath & "/" & Newname)

oldNames(i) = CStr(.FoundFiles(i))

Name CStr(oldNames(i)) As newNames(i)

Next i

Else

MsgBox "There were no files found."

End If

Application.OnUndo "撤销重命名", "UnChangePicName"

End With

Exit Sub
ErrH:

MsgBox Err.Description, vbCritical
End Sub






Sub UnChangePicName() '撤销重命名图片

Dim i As Integer

For i = 1 To UBound(newNames)

Name newNames(i) As oldNames(i)

Next i

Application.OnRepeat "重做重命名", "my_Repeat"
End Sub
Sub my_Repeat() '恢复重命名图片

Dim i As Integer

For i = 1 To UBound(newNames)

Name oldNames(i) As newNames(i)

Next i

Application.OnUndo "撤销重命名", "UnChangePicName"
End Sub





删除文件

1）、VB语句：Kill
Sub DeleteFile()

Dim strFile As String

strFile = ThisWorkbook.Path & "/Temp.xls"

Kill strFile


End Sub





Sub DeleteFile2()
Dim strFile As String

strFile = ThisWorkbook.Path & "/Temp.xls"

If Dir(strFile) = "" Then

MsgBox strFile & " does not Exists", vbCritical

Else

Kill strFile

End If
End Sub


2）、FileSystemObject对象：DeleteFile方法
Sub DeleteFile_Fso()

Dim fso As FileSystemObject

Dim strFile As String

strFile = ThisWorkbook.Path & "/test.xls"

Set fso = New FileSystemObject

If fso.FileExists(strFile) Then

fso.DeleteFile strFile

Else

MsgBox strFile & " does not Exists"

End If

Set fso = Nothing
End Sub
10、文件自杀
VB语句：Kill
Sub KillMe()

Application.DisplayAlerts = False

ActiveWorkbook.ChangeFileAccess xlReadOnly

Kill ActiveWorkbook.FullName

ThisWorkbook.Close False
End Sub

 


 
二.文件夹操作

1、新建文件夹

Sub MkDirFolder()

Dim strfolder As String

strfolder = ThisWorkbook.Path & "/Temp"

On Error GoTo ErrHandle

MkDir strfolder

MsgBox "Create New Folder: " & strfolder, vbInformation

On Error GoTo 0



Exit Sub
ErrHandle:

MsgBox "Folder already Exists.", vbInformation
End Sub

Sub MakeFolder_fso()

Dim fso As New FileSystemObject

Dim strfolder As String



strfolder = ThisWorkbook.Path & "/Temp"


If Not fso.FolderExists(strfolder) Then

fso.CreateFolder strfolder

MsgBox "Create a Temp folder.", vbInformation

Else

MsgBox "Folder already Exists.", vbInformation

End If

Set fso = Nothing
End Sub

2、打开文件夹

1）、Shell

Sub ShellFolder()

Shell "explorer.exe E:/inbox/", 1


End Sub


2)、引用Microsoft Shell Controls And Automation动态库

Sub OpenFolder()

Dim strFolder As String

Dim oShell As Shell32.Shell



Set oShell = New Shell32.Shell

strFolder = "E:/inbox/"

oShell.Explore strFolder
End Sub

1）后期绑定方式，选择文件夹

Sub SelectFolder()

Dim Shapp As Object

Dim Path1 As Object



Set Shapp = CreateObject("Shell.Application")

Set Path1 = Shapp.BrowseForFolder(0, "请选择文件夹", 0, 0)

If Path1 Is Nothing Then Exit Sub

MsgBox Path1.Self.Path
End Sub

2、复制文件夹
FileSystemObject对象：CopyFolder
Sub CopyFile_fso()

Dim fso As New FileSystemObject

Dim strSfolder As String

Dim strDfolder As String

strSfolder = ThisWorkbook.Path & "/Temp"

strDfolder = ThisWorkbook.Path & "/MoveFile/"

fso.CopyFolder strSfolder, strDfolder

Set fso = Nothing
End Sub
1、移动文件夹
FileSystemObject对象：MoveFolder

Sub MoveFolder_fso()

Dim fso As New FileSystemObject

Dim strSfolder As String

Dim strDfolder As String



strSfolder = ThisWorkbook.Path & "/Temp"

strDfolder = ThisWorkbook.Path & "/MoveFile/"

If Not fso.FolderExists(strSfolder) Then


MsgBox " Folder does not Exists.", vbCritical

Else

fso.MoveFolder strSfolder, strDfolder

MsgBox "Folder Move to " & strDfolder

End If



Set fso = Nothing
End Sub


2、删除文件夹
VB语句：RmDir

Sub DeleteFolder()

Dim strFolder As String

strFolder = ThisWorkbook.Path & "/Temp"

On Error GoTo ErrHandle

RmDir strFolder

MsgBox "Delete Folder: " & strFolder, vbInformation

On Error GoTo 0



Exit Sub
ErrHandle:

MsgBox "Folder does not Exists.", vbCritical
End Sub


Shell语句
Sub DeleteFolder2()

KillFolder ThisWorkbook.Path & "/Temp"
End Sub

Sub KillFolder(MyFolderPath As String)

Shell "cmd.exe /c rmdir /s/q " & Chr(34) & MyFolderPath & Chr(34)
End Sub


FileSystemObject对象：DeleteFolder

Sub DeleteFolder_fso()

Dim strFolder As String

Dim fso As New FileSystemObject



strFolder = ThisWorkbook.Path & "/Temp"

If fso.FolderExists(strFolder) Then

fso.DeleteFolder strFolder

Else

MsgBox "Folder does not Exists.", vbCritical

End If



Set fso = Nothing
End Sub

1、获取父文件夹名
FileSystemObject对象：ParentFolder
Sub ParentFolderName_fso()
Dim fso As New FileSystemObject
Dim strPath As String


strPath = ThisWorkbook.Path & "/Temp"

MsgBox "Path: " & strPath & vbCrLf & vbCrLf & _

"Paren Path: " & fso.GetFolder(strPath).ParentFolder.Name

End Sub

VBA ：Split函数
Sub ParentFolderName()
Dim arr As Variant
Dim strPath As String


strPath = ThisWorkbook.Path & "/Temp"

arr = Split(strPath, "/")

MsgBox "Path: " & strPath & vbCrLf & vbCrLf & _

"Paren Path: " & arr(UBound(arr) - 1)

End Sub

2、文件夹重命名
FileSystemObject对象：Folder.name
Dim OldFolder As String, NewFolder As String

Sub ReNameFolder_fso()

Dim fso As New FileSystemObject

Dim oFolder As Folder

Dim strOldFolder As String

Dim strNewFolder As String



strOldFolder = ThisWorkbook.Path & "/Temp"

strNewFolder = "New Temp"

If Not fso.FolderExists(strOldFolder) Then

MsgBox "Folder does not Exist.", vbCritical

Else


Set oFolder = fso.GetFolder(strOldFolder)

oFolder.Name = strNewFolder

End If
End Sub

VB语句：Name
Sub ReNameFolder()

OldFolder = ThisWorkbook.Path & "/Temp"

NewFolder = ThisWorkbook.Path & "/New Temp"

Name OldFolder As NewFolder
End Sub

Sub UnChangeReNameFolder()

Name NewFolder As OldFolder
End Sub

刚遇到这个问题就问度娘了，奈何上面全是C#的解决方法：
大体意思就是在项目Properties下找到licenses.licx文件，直接删除或者把生成属性设置成“无”。
然后我大VB没有Properties这个东东，于是在项目文件里检索了一下，发现licenses.licx文件在My Project文件夹里，于是打开VS想去改属性，然而在解决方案视图下My Project并没有下一级的列表，双击是直接打项目属性的配置界面，找遍所有地方没找到相关的东西，于是切换到文件夹视图，找到licenses.licx文件，右键，额。。。没有“属性”这个选项。彻底蒙逼。
最后：直接打开licenses.licx文件，删除里面所vb.net教程有内容，弹框没了，解决问题。