完美Excel

在dicks的blog中看到了一段解决同名文件问题的程序解决方案，贴出来共享。
有时，必须存储一个名称与现有文件名相同的文件，此时可以在名称末尾添加数字使其唯一。但问题是该文件将放在三个不同的文件夹中：Working、Review和Archive，需要在这三个文件夹中检查相同的文件名称。
现在，创建一个函数来返回下一个可用的后缀，如果没有相同的文件存在，返回空字符串；如果有相同的文件存在，则返回能够添加到文件名后使其唯一的数字。
该函数遍历文件夹并使用Dir函数来获取相同的名称。为了使用Dir，将搜索的文件更改为包含有星号（*），例如名称为MyFile.xls的成为MyFile*.xls，并且将查找MyFile.xls、MyFile1.xls等等。如果找到匹配项，将分隔数字并记录下最终找到的最大的一个数字。如果没有数字，Replace语句返回一个空字符串并且Val函数将其转换为0。
Function GetUniqueSuffix(sName As String, vaFolders As Variant) As String
    Dim lSuffix As Long, lMax As Long
    Dim sDirName As String
    Dim sBaseName As String
    Dim i As Long
    Dim sTempName As String
    
    Const sEXTENSION As String = “.xls”
    
    sDirName = Replace(sName, sEXTENSION, “*” & sEXTENSION)
    sBaseName = Replace(sName, sEXTENSION, “”)
    
    For i = LBound(vaFolders) To UBound(vaFolders)
        sTempName = Dir(vaFolders(i) & sDirName)
        Do Until Len(sTempName) = 0
            lSuffix = Val(Replace(Replace(sTempName, sBaseName, “”), sEXTENSION, “”)) + 1
            If lSuffix > lMax Then
                lMax = lSuffix
            End If
            sTempName = Dir
        Loop
    Next i
    
    If lMax > 0 Then
        GetUniqueSuffix = CStr(lMax)
    Else
        GetUniqueSuffix = “”
    End If
    
End Function

使用示例:
Sub UniqueSuffixExample()
    
    Dim vaFolders As Variant
    Dim sFile As String
    Dim lUnique As Long
    
    vaFolders = Array(”C:\Working\”, “C:\Review\”, “C:\Archive\”)
    sFile = “MyFile.xls”
    
    lUnique = GetUniqueSuffix(sFile, vaFolders)
    sFile = Replace(sFile, “.xls”, lUnique & “.xls”)
    
    ActiveWorkbook.SaveAs “C:\Working\” & sFile
    
End Sub

FileSystemObject对象位于File System对象模型(如下图所示)的最高层，提供了对计算机文件系统的访问。要访问File System对象模型，需要添加对Microsoft Scripting Runtime库的引用，然后可以创建FileSystemObject对象的一个实例。使用File System对象模型，可以访问本地文件或网络文件，允许查找、创建、删除或者用其他方法操作文件夹和文本文件。

语法：Scripting.FileSystemObject
属性：Drives 属性
方法：BuildPath方法、CopyFile方法、CopyFolder方法、CreateFolder方法、CreaterTextFile方法、DeleteFile方法、DeleteFolder方法、DriveExists方法、FileExists方法、FolderExists方法、GetAbsolutePathName方法、GetBaseName方法、GetDrive方法、GetDriveName方法、GetExtensionName方法、GetFile方法、GetFileName方法、GetFolder方法、GetParentFolderName方法、GetSpecialFolder方法、GetTempName方法、MoveFile方法、MoveFolder方法、OpenTextFile方法
示例：
Sub test()
    Dim fs As FileSystemObject
    Dim a As TextStream
    Set fs = CreateObject(”Scripting.FileSystemObject”)
    Set a = fs.CreateTextFile(”c:\testfile.txt”, True)
    a.WriteLine (”This is a test.”)
    a.Close
End Sub

上面的示例代码中，CreateObject函数返回一个FileSystemObject对象，然后使用CreateTextFile方法在C盘根目录下创建一个名为testfile.txt的文本文件，该文件为一个TextStream对象。代码中的WriteLine方法向创建的文本文件中写入一行文本，Close方法用于刷新缓冲区并关闭文件。

文章参考:j-walk.com/ss
在Excel应用程序中，可以使用GetOpenFileName方法显示一个提示文件名的对话框，但没有仅仅显示目录的对话框的方式。
这里，提供一个函数(名为GetDirectory)用来显示下面所示的对话框，返回代表所选目录的字符串。如果用户单击“取消”，则该函数返回一个空字符串。

GetDirectory函数接受一个参数，该参数是可选的，代表显示在对话中的字符串。若忽略该参数，则对话框中显示“选择文件夹”字符串。
GetDirectory函数及其调用示例代码如下：

运行test()子过程，选择目录后单击“确定”按钮，则在Msgbox消息框中将显示该目录的路径字符串。