StrComp问题

Question

我有一个包含数百个客户名称和几个商品编号的Excel文件。我要实现的是拥有一个宏，该宏可以检查是否存在具有所选客户名称的文件夹，如果缺少该文件夹，则创建一个新文件夹。找到或创建了客户文件夹后，宏应检查每个商品编号是否存在一个文件夹，如果缺少，则创建一个新的文件夹。我发现了一个代码似乎可以完成所有这些工作，而且斯科特·霍尔茨曼（Scott Holtzman）发布了更多代码，但是由于我的声誉太低，无法发表评论，因此我无法在该主题中提出解释。

我已将Microsoft Scripting Runtime引用为代码请求，但是两个“ If not”语句均标记为红色，并且弹出窗口仅显示“ Compile error”。我已经检查了“ If not”语句的语法，这似乎是正确的，但是由于我没有VBA经验，所以无法确定。还有什么我应该激活的地方才能起作用吗？

'requires reference to Microsoft Scripting Runtime
Sub MakeFolder()

Dim strComp As String, strPart As String, strPath As String

strComp = Range("A1") ' assumes company name in A1
strPart = CleanName(Range("C1")) ' assumes part in C1
strPath = "C:\Images\"

If Not FolderExists(strPath & strComp) Then 
'company doesn't exist, so create full path
    FolderCreate strPath & strComp & "\" & strPart
Else
'company does exist, but does part folder
    If Not FolderExists(strPath & strComp & "\" & strPart) Then
        FolderCreate strPath & strComp & "\" & strPart
    End If
End If

End Sub

Function FolderCreate(ByVal path As String) As Boolean

FolderCreate = True
Dim fso As New FileSystemObject

If Functions.FolderExists(path) Then
    Exit Function
Else
    On Error GoTo DeadInTheWater
    fso.CreateFolder path ' could there be any error with this, like if the path is really screwed up?
    Exit Function
End If

DeadInTheWater:
    MsgBox "A folder could not be created for the following path: " & path & ". Check the path name and try again."
    FolderCreate = False
    Exit Function

End Function

Function FolderExists(ByVal path As String) As Boolean

FolderExists = False
Dim fso As New FileSystemObject

If fso.FolderExists(path) Then FolderExists = True

End Function

Function CleanName(strName as String) as String
'will clean part # name so it can be made into valid folder name
'may need to add more lines to get rid of other characters

    CleanName = Replace(strName, "/","")
    CleanName = Replace(CleanName, "*","")
    etc...

End Function

Answer 1

看看下面的示例，它显示了使用递归子调用的一种可能方法：

Option Explicit

Sub TestArrays()

    Dim aCustomers
    Dim aArticles
    Dim sCustomer
    Dim sArticle
    Dim sPath

    sPath = "C:\Test"
    aCustomers = Array("Customer01", "Customer02", "Customer03", "Customer04", "Customer05")
    aArticles = Array("Article01", "Article02", "Article03", "Article04", "Article05")
    For Each sCustomer In aCustomers
        For Each sArticle In aArticles
            SmartCreateFolder sPath & "\" & sCustomer & "\" & sArticle
        Next
    Next

End Sub

Sub TestFromSheet()

    Dim aCustomers
    Dim aArticles
    Dim i
    Dim j
    Dim sPath

    sPath = "C:\Test"
    With ThisWorkbook.Sheets(1)
        aCustomers = .Range(.Range("A1"), .Range("A1").End(xlDown)).Value
        aArticles = .Range("B1:B10").Value
    End With
    For i = LBound(aCustomers, 1) To UBound(aCustomers, 1)
        For j = LBound(aArticles, 1) To UBound(aArticles, 1)
            SmartCreateFolder sPath & "\" & aCustomers(i, 1) & "\" & aArticles(j, 1)
        Next
    Next

End Sub

Sub SmartCreateFolder(sFolder)

    Static oFSO As Object

    If oFSO Is Nothing Then Set oFSO = CreateObject("Scripting.FileSystemObject")
    With oFSO
        If Not .FolderExists(sFolder) Then
            SmartCreateFolder .GetParentFolderName(sFolder)
            .CreateFolder sFolder
        End If
    End With

End Sub

Sub TestArrays()检查并为硬编码数组中的客户和商品创建文件夹，Sub TestFromSheet()从第一个工作表中获取客户和商品，例如，客户的范围从A1到最后一个元素，因此在那里应该有多个元素，并且商品设置为固定范围B1：B10，如下所示：

Answer 2

StrComp问题

您不能使用StrComp ，它是保留字，实际上是字符串函数。前几天，我在此问题上损失了大约15分钟。

VBA说：返回表示字符串比较结果的Variant（整数）。

Answer 3

如果您想简化一些代码，请使用MKDIR创建每个级别的文件夹\子文件夹，并传递错误。

View

Answer 4

要在创建所有子目录的情况下将现有文件重命名到新位置，可以使用：

File_Name_OLD = File_Pad_OLD & "Test.txt"
File_Pad_NEW = "e:\temp\test1\test2\test3\"
File_Name_NEW = File_Pad_NEW & "Test.txt"

X = File_Pad_NEW
A = 1
Do Until A = 0
A = InStr(X, "\")
Y = Y & Left(X, A)
X = Mid(X, A + 1)
If Dir(Y, 16) = "" Then MkDir Y
Loop
Name File_Name_OLD As File_Name_NEW

这将创建带有子目录的新路径，并将旧文件重命名为新文件。

在Excel VBA中创建文件夹和子文件夹

4 个答案:

StrComp问题