Hi Sir I know its that too far from the time its posted but i've tried it then it goes compile error i followed the method in deleting the cursor.

thank you regards
giox



Quote Originally Posted by gmaxey View Post
I would pass the root folder to a recursive function that returned I and all subfolders:

Option Explicit
Sub BatchProcessFolderAndSubFolders()
Dim vFolders As Variant
Dim lngIndex As Long
Dim strPath As String
Dim strfilename As String
  vFolders = fcnGetSubfolders("d:\My Documents\Word\Word Documents\Word Tips\Macros")
  For lngIndex = LBound(vFolders) To UBound(vFolders)
    strPath = vFolders(lngIndex)
    On Error GoTo Err_NoFiles
    strfilename = Dir$(strPath & "*.do*")
    While Len(strfilename) <> 0
      'You could open the file here and pass it to a function to do something to it.
      Debug.Print strfilename
      strfilename = Dir$()
    Wend
ReEntry:
  Next
lbl_Exit:
  Exit Sub
Err_NoFiles:
  Resume ReEntry
End Sub
Public Function fcnGetSubfolders(ByVal FolderToRead As String) As Variant
Dim AllSubFolders(0) As Variant
  On Error Resume Next
  System.Cursor = wdCursorWait
  If (Right$(FolderToRead, 1) <> "\") Then FolderToRead = FolderToRead & "\"
  'Set the path as the first entry in the array and pass the array to the main function.
  AllSubFolders(0) = FolderToRead
  fcnGetSubfolders = fcnGetAllSubfolders(AllSubFolders)
  System.Cursor = wdCursorNormal
  'StatusBar = ""
  On Error GoTo 0
lbl_Exit:
  Exit Function
End Function
Private Function fcnGetAllSubfolders(ByVal AllSubFoldersArray As Variant) As Variant
'This is a recursive function, that is it calls itself as required.
Dim lngCounter As Long
Dim strCurrentFolderName As String
Dim strSubFolderName As String
Dim arrSubFolderList() As String
  On Error Resume Next
  strCurrentFolderName = CStr(AllSubFoldersArray(UBound(AllSubFoldersArray)))
  ReDim arrSubFolderList(0)
  strSubFolderName = Dir$(strCurrentFolderName, vbDirectory)
  Do While Len(strSubFolderName) <> 0
    If strSubFolderName <> "." _
       And strSubFolderName <> ".." _
       And InStr(1, strSubFolderName, "?") = 0 Then
      If (GetAttr(strCurrentFolderName & strSubFolderName) And vbDirectory) = vbDirectory Then
        ReDim Preserve arrSubFolderList(UBound(arrSubFolderList) + 1)
        arrSubFolderList(UBound(arrSubFolderList)) = strSubFolderName
        'StatusBar = "Reading Subfolders... (" & strCurrentFolderName & ": -> " & strSubFolderName & ")"
      End If
    End If
    strSubFolderName = Dir$()
  Loop
  'Sort the list with the subfolders.
  If UBound(arrSubFolderList) > 0 Then WordBasic.SortArray arrSubFolderList()
  For lngCounter = 1 To UBound(arrSubFolderList)
    'Up the size of the AllSubFoldersArray array by one
    ReDim Preserve AllSubFoldersArray(UBound(AllSubFoldersArray) + 1)
    AllSubFoldersArray(UBound(AllSubFoldersArray)) = _
      strCurrentFolderName & arrSubFolderList(lngCounter) & "\"
    AllSubFoldersArray = fcnGetAllSubfolders(AllSubFoldersArray)
  Next lngCounter
  fcnGetAllSubfolders = AllSubFoldersArray
  On Error GoTo 0
End Function