2016-06-14 78 views
1

我有一个函数,它是布尔值,并返回是否是小区确定为根据其值或创建一个新文件夹它不是(如果。它由以下字符:<,>, |,\,* ,?)正则表达式的VBA Excel宏新文件夹字符

但一些奇怪的原因,它总是返回假的,要么是细胞正常与否。 因此,我有一个为所有行创建一个循环并创建一些.txt文件并将其放入自动生成的文件夹的子文件。

这里是我的代码:

Sub CreateTxtSrb() 
Dim iRow As Long 
Dim iFile As Integer 
Dim sPath As String 
Dim sFile As String 
Dim iEnd As Range 
'iEnd = Cells(Rows.Count, "B").End(xlUp).Row 
For iRow = 1 To Cells(Rows.Count, "B").End(xlUp).Row 
    iFile = FreeFile 
With Rows(iRow) 
    If IsValidFolderName(.Range("B2").Value) = False Or IsValidFolderName(.Range("D2").Value) = False Or IsValidFolderName(.Range("F2").Value) = False Then 
     MsgBox ("Check columns B,D or F, it cannot contains chars: <,>,?,|,\,/,*,. or a space at the end") 
     Exit Sub 
    Else 
    strShort = IIf(InStr(.Range("E2").Value, vbCrLf), Left(.Range("E2").Value, InStr(.Range("E2").Value, vbCrLf) - 2), .Range("E2").Value) 
     sPath = "E:\" & .Range("B2").Value & "\" 
     If Len(Dir(sPath, vbDirectory)) = 0 Then MkDir sPath 
     sFile = .Range("D2").Value & ".txt" 
     Open sPath & sFile For Output As #iFile 
     Print #iFile, .Range("E2").Value 
     Close #iFile 
    End If 
End With 
Next iRow 
End Sub 

Function IsValidFolderName(ByVal sFolderName As String) As Boolean 
'http://msdn.microsoft.com/en- us/library/windows/desktop/aa365247(v=vs.85).aspx#file_and_directory_names 
'http://msdn.microsoft.com/en-us/library/ie/ms974570.aspx 
On Error GoTo Error_Handler 
Dim oRegEx   As Object 

'Check to see if any illegal characters have been used 
Set oRegEx = CreateObject("vbscript.regexp") 
oRegEx.Pattern = "[&lt;&gt;:""/\\\|\?\*]" 
IsValidFolderName = Not oRegEx.test(sFolderName) 
'Ensure the folder name does end with a . or a blank space 
If Right(sFolderName, 1) = "." Then IsValidFolderName = False 
If Right(sFolderName, 1) = " " Then IsValidFolderName = False 

Error_Handler_Exit: 
On Error Resume Next 
Set oRegEx = Nothing 
Exit Function 

Error_Handler: 
MsgBox ("test") 
' MsgBox "The following error has occurred" &amp; vbCrLf &amp; vbCrLf &amp; _ 
'   "Error Number: " &amp; Err.Number &amp; vbCrLf &amp; vbCrLf &amp; _ 
'   "Error Source: IsInvalidFolderName" &amp; vbCrLf &amp; _ 
'   "Error Description: " &amp; Err.Description, _ 
'   vbCritical, "An Error has Occurred!" 
Resume Error_Handler_Exit 
End Function 

我怎样才能让如果需要的话就返回true?

回答

1

不需要外部参考,你可以简单地说:我加":这也是非法

hasInvalidChars = sFolderName like "*[<>|\/:*?""]*" 

(在你的榜样,你有HTML实体(例如&lt;) - 这些没有任何意义在您正则表达式的字符串和被解释为在类4个字符)

+0

感谢亚历克斯,你的解决方案是更优雅。我没有意识到一种“喜欢”的方法。每天都有新的东西。 :) – Stefan0309

1

这是一个烂摊子。使用单独的功能

Public Function IsInvalid(ByVal name As String) As Boolean 
    Dim regex As Object 
    Set regex = VBA.CreateObject("VBScript.RegExp") 
    regex.Pattern = "[\\/:\*\?""<>\|]" 'the disallowed characters 
    IsInvalid = (regex.Execute(name).Count > 0) 
End Function 

改为,并在适当时调用它。