Valhalla Legends Forums Archive | Visual Basic Programming | Need some help

AuthorMessageTime
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

Search