I'm trying to convert a few macros to work from Word 2003 to Word 2007.
The follow code works under Word 2003.
Private Sub UserForm_Initialize()
'Dim wdApp As Word.Application
'Set wdApp = New Word.Application
Dim subfolders As Boolean
Dim MyPath As String
Dim MyPath2 As String
Dim MyPath3 As String
Dim MyPath4 As String
Dim MyPath5 As String
Dim MyName As String
subfolders = False
MyPath = variables.formspath
MyPath2 = variables.formspath & "ACU Forms"
MyPath3 = variables.formspath & "Directors Office"
MyPath4 = variables.formspath & "Insolvency"
MyPath5 = variables.formspath & "Revenue"
'strip quotation marks from path
If Len(MyPath) = 0 Then Exit Sub
'If Asc(MyPath) = 34 Then
'MyPath = Mid$(MyPath, 2, Len(MyPath) - 2)
'End If
'========== Page 1 ====================
'get files from the selected folder path
'and insert them into the select ListBox
'MyName = Dir$(MyPath & "*.*")
CustomFindFile "*.dot", MyPath, False, 1
'========== Page 2 ====================
CustomFindFile "*.dot", MyPath2, False, 2
'========== Page 3 ====================
CustomFindFile "*.dot", MyPath3, False, 3
'========== Page 4 ====================
CustomFindFile "*.dot", MyPath4, True, 4
'========== Page 5 ====================
CustomFindFile "*.dot", MyPath5, True, 5
End Sub
'==========
Function CustomFindFile(strFileSpec As String, path As String, recursive As Boolean, vList As Integer)
Dim fsoFileSearch As FileSearch
Dim i As Integer, j As Integer
Dim insert As Boolean
Dim aSize As Long
Dim bsize As Long
Dim formFiles0() As String 'filenames
Dim formFiles1() As String 'fullpath filenames
Dim k As Integer
k = 0
ClearFindAndReplaceParameters
Set fsoFileSearch = Application.FileSearch
With fsoFileSearch
.NewSearch
.LookIn = path
.filename = strFileSpec
.SearchSubFolders = recursive
If .Execute() > 0 Then
ReDim formFiles0(1 To .FoundFiles.count)
ReDim formFiles1(1 To .FoundFiles.count)
'assign found files to an array
For i = 1 To .FoundFiles.count
'strFileList = strFileList & Dir(.foundfile(i), vbDirectory) & vbCrLf
'lstFileList.AddItem Dir(.FoundFiles(i), vbDirectory)
If Dir(.FoundFiles(i), vbDirectory) <> "" Then
k = k + 1
formFiles1(k) = .FoundFiles(i)
formFiles0(k) = Dir(.FoundFiles(i), vbDirectory)
End If
Next i
'assign files to correpsonding page list
'================== Page 1 - Operations - LIST
If vList = 1 Then
'remove duplicates from array of filenames
aSize = UniquifyStringArray(formFiles0, uFormFiles0)
uFormFiles1 = formFiles1
For i = 1 To aSize
select_userForm.lstFileList.AddItem uFormFiles0(i)
Next i
'================== Page 2 - ACU - LIST
ElseIf vList = 2 Then
aSize = UniquifyStringArray(formFiles0, pg2FormFiles0)
pg2FormFiles1 = formFiles1
For i = 1 To aSize
select_userForm.lstFileList2.AddItem pg2FormFiles0(i)
Next i
'================== Page 3 - AM - LIST
ElseIf vList = 3 Then
aSize = UniquifyStringArray(formFiles0, pg3FormFiles0)
pg3FormFiles1 = formFiles1
For i = 1 To aSize
select_userForm.lstFileList3.AddItem pg3FormFiles0(i)
Next i
'================== Page 4 - Insolvency - LIST
ElseIf vList = 4 Then
aSize = UniquifyStringArray(formFiles0, pg4FormFiles0)
pg4FormFiles1 = formFiles1
For i = 1 To aSize
select_userForm.lstFileList4.AddItem pg4FormFiles0(i)
Next i
ElseIf vList = 5 Then
aSize = UniquifyStringArray(formFiles0, pg5FormFiles0)
pg5FormFiles1 = formFiles1
For i = 1 To aSize
select_userForm.lstFileList5.AddItem pg5FormFiles0(i)
Next i
End If
End If
End With
'MsgBox strFileList
End Function
Function UniquifyStringArray(ByRef InputArray() As String, _
ByRef UniqueArray() As String) As Long
Dim C As New Collection
Dim i As Long
On Error Resume Next
For i = LBound(InputArray) To UBound(InputArray)
C.Add InputArray(i), InputArray(i)
Next
ReDim UniqueArray(1 To C.count)
For i = 1 To C.count
UniqueArray(i) = C(i)
Next
UniquifyStringArray = C.count
Set C = Nothing
End Function
The main problem with the code is located here
in the CustomFileFind Function.
Function CustomFindFile(strFileSpec As String, path As String, recursive As Boolean, vList As Integer)
Dim fso As New FileSystemObject
Dim folder, files
Dim fileArray(1000) As String
Dim folderIdx As Variant
Dim i As Integer, j As Integer, m As Integer
Dim count As Integer
Dim insert As Boolean
Dim aSize As Long
Dim bsize As Long
Dim formFiles0() As String 'filenames
Dim formFiles1() As String 'fullpath filenames
Dim k As Integer
k = 0
count = 1
ClearFindAndReplaceParameters
'With fsoFileSearch
'.NewSearch
'.LookIn = path
'.filename = strFileSpec
'.SearchSubFolders = recursive
'If .Execute() > 0 Then
Set folder = fso.GetFolder(path)
Set files = folder.files
For Each folderIdx In files
fileArray(count) = folderIdx.name
count = count + 1
Next
ReDim formFiles0(1 To count)
ReDim formFiles1(1 To count)
'assign found files to an array
For i = 1 To count
'strFileList = strFileList & Dir(.foundfile(i), vbDirectory) & vbCrLf
'lstFileList.AddItem Dir(.FoundFiles(i), vbDirectory)
If Dir(fileArray(i), vbDirectory) <> "" Then
k = k + 1
formFiles1(k) = fileArray(i)
Debug.Print "testing!"
' skips over next debug.print... WHY?
Debug.Print fileArray(i)
formFiles0(k) = Dir(fileArray(i), vbDirectory)
End If
Next i
Debug.Print "Made it to here!"
'assign files to correpsonding page list
'================== Page 1 - Operations - LIST
If vList = 1 Then
'remove duplicates from array of filenames
aSize = UniquifyStringArray(formFiles0, uFormFiles0)
uFormFiles1 = formFiles1
For i = 1 To aSize
select_userForm.lstFileList.AddItem uFormFiles0(i)
Next i
'================== Page 2 - ACU - LIST
ElseIf vList = 2 Then
aSize = UniquifyStringArray(formFiles0, pg2FormFiles0)
pg2FormFiles1 = formFiles1
For i = 1 To aSize
select_userForm.lstFileList2.AddItem pg2FormFiles0(i)
Next i
'================== Page 3 - AM - LIST
ElseIf vList = 3 Then
aSize = UniquifyStringArray(formFiles0, pg3FormFiles0)
pg3FormFiles1 = formFiles1
For i = 1 To aSize
select_userForm.lstFileList3.AddItem pg3FormFiles0(i)
Next i
'================== Page 4 - Insolvency - LIST
ElseIf vList = 4 Then
aSize = UniquifyStringArray(formFiles0, pg4FormFiles0)
pg4FormFiles1 = formFiles1
For i = 1 To aSize
select_userForm.lstFileList4.AddItem pg4FormFiles0(i)
Next i
ElseIf vList = 5 Then
aSize = UniquifyStringArray(formFiles0, pg5FormFiles0)
pg5FormFiles1 = formFiles1
For i = 1 To aSize
select_userForm.lstFileList5.AddItem pg5FormFiles0(i)
Next i
End If
'MsgBox strFileList
End Function
Basically since the FileSearch function is not supported in the Object Library for Word 2007, I tried to use the FileSystemObject to get a listing and a counter to count the total number of files in a specific 'path'. when I debug.printed the array that I placed each filename found, it printed out valid results. When I replaced the variable names and tried to see if I could get the same result from Word 2003, I was unsuccessful.
Once it gets past the "Made it to here!" debug.print, it tries to place those values into these values.
If vList = 1 Then
'remove duplicates from array of filenames
aSize = UniquifyStringArray(formFiles0, uFormFiles0)
uFormFiles1 = formFiles1
For i = 1 To aSize
select_userForm.lstFileList.AddItem uFormFiles0(i)
Next i
My code runs, but produces undesired results. Mainly, instead of placing each filename found into its respected 'tab' it places a '.'
I know the code is buggy around,
'With fsoFileSearch
'.NewSearch
'.LookIn = path
'.filename = strFileSpec
'.SearchSubFolders = recursive
'If .Execute() > 0 Then
Set folder = fso.GetFolder(path)
Set files = folder.files
For Each folderIdx In files
fileArray(count) = folderIdx.name
count = count + 1
debug.print fileArray(count)
Next
ReDim formFiles0(1 To count)
ReDim formFiles1(1 To count)
'assign found files to an array
For i = 1 To count
'strFileList = strFileList & Dir(.foundfile(i), vbDirectory) & vbCrLf
'lstFileList.AddItem Dir(.FoundFiles(i), vbDirectory)
If Dir(fileArray(i), vbDirectory) <> "" Then
k = k + 1
formFiles1(k) = fileArray(i)
Debug.Print "testing!"
' skips over next debug.print... WHY? (doesn't print variable name)
Debug.Print fileArray(i)
formFiles0(k) = Dir(fileArray(i), vbDirectory)
End If
Next i
Debug.Print "Made it to here!"
So if I can get some advice on what I am doing wrong here, it would be great! I'm not the greatest at Visual Basic, but some help would be nice.