Author | Message | Time |
---|---|---|
MrRaza | I'm trying to convert a few macros to work from Word 2003 to Word 2007. The follow code works under Word 2003. [code] 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 [/code] The main problem with the code is located here in the CustomFileFind Function. [code] 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 [/code] 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. [code]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 [/code] 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, [code] '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!" [/code] 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. | March 10, 2009, 6:42 PM |