这代码功能是正常的,但又缺陷,哪位老师帮忙修改一下

高调的鳄鱼

这代码功能是正常的,但又缺陷,哪位老师帮忙修改一下
缺陷是:当文件夹为空的时候,会提示出错.
Sub 宏14()
'
' 宏14 宏
'
     Range("az19:ba981").Select
    Selection.ClearContents
    Range("a3").Select
    Dim m, FD, FF, MyPath$, mh, arr() As String, FSO As Object, reg As Object
    Set FSO = CreateObject("Scripting.FileSystemObject")
    MyPath = "D:\分析进行中\h1\"
    Set FD = FSO.getfolder(MyPath)
    Set FF = FD.Files 'ok文件加下文件
    m = FF.Count  'ok文件加下文件数量
    ReDim arr(1 To m, 1 To 2)
    '提取需要的内容
    Set reg = CreateObject("VBScript.RegExp")
    reg.Global = True
    reg.Pattern = "([0-9]+)-([0-9]+)"
    For Each f In FF
        If reg.test(f) Then
          i = i + 1
          Set mh = reg.Execute(f)
          arr(i, 1) = mh(0).submatches(0)
          arr(i, 2) = mh(0).submatches(1)
        End If
    Next
    Set reg = Nothing
    Set FSO = Nothing
    Set FF = Nothing
    Set FD = Nothing
    Sheet1.Range("az19").Resize(UBound(arr), UBound(arr, 2)) = arr
    Range("az19:ba981").Select
    With Selection.Font
        .Color = -16776961
        .TintAndShade = 0
    Range("a3").Select '鼠标停放
    End With
'
End Sub

taller