Please Help! Really stuck.

[kanejone]

Hi guys
I still trying to fix an old problem. I have a routine that has 2 arrays, one take in the filesize from one folder from all files with an extension of .ack and the other takes in filesize from all files with an extension .ack from files in a folder that is dynamically generated every day.

Public MyNewDir As String

Private Sub Sizechecking()
    Dim FSO As Object
    Set FSO = CreateObject("Scripting.FileSystemObject")
    Dim today As String
    today = Format(Now, "dd mmmm yyyy")
    Dim sFolder1 As String
    Dim sFolder2 As String
    Dim sFile As String
    Dim lCounter1 As Long
    Dim lCounter2 As Long
    Dim fileArray1() As File_Info
    Dim fileArray2() As File_Info
    ReDim fileArray1(0)
    ReDim fileArray2(0)
    
    sFolder1 = "D:\Orator\IBMOutgoing\"
'This is where the problem is, it won't understand that sFolder2 is = MyNewDir
    sFolder2 = MyNewDir
    'Read Contentents of Folder
    sFile = Dir(sFolder1 & "*.ack")
    Do Until sFile = ""
        'Add File Info to the array
        fileArray1(UBound(fileArray1)).sFileName = sFile
        fileArray1(UBound(fileArray1)).lFileSize = FileLen(sFolder1 & sFile)
        'Expand the array for the next item
        ReDim Preserve fileArray1(UBound(fileArray1) + 1)
        sFile = Dir
    Loop
    
    'Remove the last item cause its empty
    If UBound(fileArray1) > 0 Then
        ReDim Preserve fileArray1(UBound(fileArray1) - 1)
    End If
    
    
    
    'Read Contentents of Folder
    sFile = Dir(sFolder2 & "*.ack")
'Here it read doesn't read the contents of the folder
    Do Until sFile = ""
        'Add File Info to the array
        fileArray2(UBound(fileArray2)).sFileName = sFile
        fileArray2(UBound(fileArray2)).lFileSize = FileLen(sFolder2 & sFile)
        'Expand the array for the next item
        ReDim Preserve fileArray2(UBound(fileArray2) + 1)
        sFile = Dir
    Loop
    
    'Remove the last item cause its empty
    If UBound(fileArray2) > 0 Then
        ReDim Preserve fileArray1(UBound(fileArray2) - 1)
    End If

The folder MYDir does exist and the files that are in it are the same as thise in the original. But when it gets to the loop to read in the contents of the sFolder2 it won't work. sFolder2 is = to MyDir which does exist???

  
   sFile = Dir(sFolder2 & "*.ack")
    Do Until sFile = ""
        'Add File Info to the array
        fileArray2(UBound(fileArray2)).sFileName = sFile
        fileArray2(UBound(fileArray2)).lFileSize = FileLen(sFolder2 & sFile)
        'Expand the array for the next item
        ReDim Preserve fileArray2(UBound(fileArray2) + 1)
        sFile = Dir
    Loop

Please help me with this. Thanks a lot in advance

[HeSaidJoe]

where are you passing a value to MyNewDir

[Edited by HeSaidJoe on 09-21-2000 at 07:16 AM]

[kanejone]

I'm doing that outside in a separate function

Private Function MakeFolderIBM(newdir As String)
        Dim dirname As String
        dirname = "D:\Orator\IBMOutgoing\"
        newdir = dirname & newdir
        ChDir dirname
        If Dir(newdir, vbDirectory) <> "" Then
        MsgBox "The Archiving Process has been started already.  Please check the Correct folder to make sure."
      Else
    MkDir newdir
    MyNewDir = newdir
       End If
End Function

Thanks
JK

The value of the

Do Until sFile = ""

seems to be still at 0 and it goes straight to the line

If UBound(fileArray2) > 0 Then

[Edited by kanejone on 09-21-2000 at 07:47 AM]

[kanejone]

Hi guys,
Sorry to ask again, but I really am at a dead end with this one. Can anyone please tell me why my second array is not populating.
Thanks a million for any help.
Take care

[HeSaidJoe]

Here is how I would do it..this works..tested...
Start a new project and copy this code into it.
Change my filenames to yours and it should work.

once you know it works then fill it into your project

Option Explicit

Sub SortNumbers(iArray As Variant)
'sort the file sizes for comparison
     Dim lLoop1 As Long
     Dim lLoop2 As Long
     Dim lTemp As Long
     
     For lLoop1 = UBound(iArray) To LBound(iArray) Step -1
       For lLoop2 = LBound(iArray) + 1 To lLoop1

         If iArray(lLoop2 - 1) > iArray(lLoop2) Then
           lTemp = iArray(lLoop2 - 1)
           iArray(lLoop2 - 1) = iArray(lLoop2)
           iArray(lLoop2) = lTemp
         End If
       Next lLoop2
     Next lLoop1
   End Sub

Private Sub Command1_Click()
'access all files within a folder

    Dim sFile1 As String
    Dim sDir1 As String
    Dim sFile2 As String
    Dim sDir2 As String
    Dim sSize1
    Dim sSize2
    Dim i As Integer
    Dim Array1()
    Dim Array2()
'get file sizes of all text folders in first folder
'store them in an array

    sDir1 = "C:\my documents\"
    sFile1 = Dir$(sDir1 & "*.txt")
    i = 0
    Do While sFile1 <> ""
    
       ReDim Preserve Array1(i)
       sSize1 = FileLen(sDir1 & sFile1)
       Array1(i) = sSize1
        
       i = i + 1
      
       sFile1 = Dir
      
    Loop
    
'sort the array
    Call SortNumbers(Array1)
    
'get the file sizes for all text files in folder two
    sDir2 = "C:\mydoc2\"
    sFile2 = Dir$(sDir2 & "*.txt")
    
    i = 0
    
    Do While sFile2 <> ""
    
       ReDim Preserve Array2(i)
       sSize2 = FileLen(sDir2 & sFile2)
       Array2(i) = sSize2
         
       i = i + 1
    
      sFile2 = Dir
     
    Loop
    
'sor the array
    Call SortNumbers(Array2)
'
'if there is a difference make note of it
    For i = LBound(Array1) To UBound(Array1)
       If Array1(i) <> Array2(i) Then
         MsgBox Array1(i) & " <> " & Array2(i)
        End If
    Next
End Sub

[kanejone]

Thanks a lot for the code. I get a RunTime Error 9 :Subscript out of range: at the line.

For lLoop1 = UBound(iArray) To LBound(iArray) Step -1

What am I doing wrong. Thanks again. JK

[HeSaidJoe]

means one of your arrays is not filled properly.
'filenames are probably the problem
'if you can't get it to work you can try this.

empty your my documents and then put in the files you want checked into my documents. then create a folder called MyDoc2 in the root of C


this example assumes that both folders have identical filenames and file counts.

[kanejone]

That's great, thanks a million. If you have the time could you possibly answer another question. How would I go about comparing the file names in the same array???

Cheers
JK

[HeSaidJoe]

That is a bit much to ask of this operation.

What would happen is this
Array1(i) = sSize1 & sFile1
that would give you the size and name in one string
for example
60myfile.txt
134newfile.txt

the trick is..how to seperate the name from the size
as the size could be 1,2,3,4,etc characters long and the
filename as well is of different lengths

If you use 2 arrays you won't be able to match them up
re: file and size as once sorted you lose perspective

perhaps a 2 dimension array but I don't know anything
that could help you using a 2 dimension array.

Sorry,
Wayne

[kanejone]

Sorry me again. Thanks a lot for all your help so far. I had it working with the files in the C:\mydocuments but then I changed it over to use my folders and it wouldn't work. Here's my code with yours added. I get the same Runtime Error 9:
Sorry I really must be wrecking your head at this stage.
Please help

'added a public var for dirname
Public MyNewDir As String
Private Type File_Info
    sFileName As String
    lFileSize As Long
End Type
Option Explicit
Private Function MakeFolderIBM(newdir As String)
        Dim dirname As String
        dirname = "D:\Orator\IBMOutgoing\"
        newdir = dirname & newdir
        ChDir dirname
        If Dir(newdir, vbDirectory) <> "" Then
        MsgBox "The Archiving Process has been started already.  Please check the Correct folder to make sure."
      Else
    MkDir newdir
    MyNewDir = newdir
       End If
End Function


Public Sub CopyTheFiles()

    Dim today As String
    Dim FSO As Object
    On Error GoTo NOFSO
    Set FSO = CreateObject("Scripting.FileSystemObject")
    today = Format(Now, "dd mmmm yyyy")
    On Error Resume Next
    FSO.CopyFile "D:\Orator\IBMOutgoing\*.ack", MyNewDir, True
    'copied the .ack  files from D:\Orator\IBMOutgoing to D:\Orator\IBMOutgoing\FOLDER(Shorttoday)

    MsgBox "The files have been Successfully transferred"
    Set FSO = Nothing
    Exit Sub
NOFSO:
    MsgBox "FSO CreateObject Failed, Copying of files"

End Sub

Sub SortNumbers(iArray As Variant)
'sort the file sizes for comparison
     Dim lLoop1 As Long
     Dim lLoop2 As Long
     Dim lTemp As Long
     
     For lLoop1 = UBound(iArray) To LBound(iArray) Step -1
       For lLoop2 = LBound(iArray) + 1 To lLoop1
         If iArray(lLoop2 - 1) > iArray(lLoop2) Then
           lTemp = iArray(lLoop2 - 1)
           iArray(lLoop2 - 1) = iArray(lLoop2)
           iArray(lLoop2) = lTemp
         End If
       Next lLoop2
     Next lLoop1
   End Sub

Private Sub Command1_Click()
'access all files within a folder
Dim shorttoday As String
shorttoday = Format(Now, "mmmm dd")
Call MakeFolderIBM(shorttoday)
Call CopyTheFiles

    Dim sFile1 As String
    Dim sDir1 As String
    Dim sFile2 As String
    Dim sDir2 As String
    Dim sSize1
    Dim sSize2
    Dim i As Integer
    Dim Array1()
    Dim Array2()
'get file sizes of all text folders in first folder
'store them in an array

    sDir1 = "D:\Orator\IBMOutgoing\"
    sFile1 = Dir$(sDir1 & "*.ack")
    i = 0
    Do While sFile1 <> ""
       ReDim Preserve Array1(i)
       sSize1 = FileLen(sDir1 & sFile1)
       Array1(i) = sSize1
       i = i + 1
       sFile1 = Dir
    Loop
    
'sort the array
    Call SortNumbers(Array1)
'get the file sizes for all text files in folder two
    sDir2 = MyNewDir
    sFile2 = Dir$(sDir2 & "*.ack")
    
    i = 0
    Do While sFile2 <> ""
       ReDim Preserve Array2(i)
       sSize2 = FileLen(sDir2 & sFile2)
       Array2(i) = sSize2
       i = i + 1
      sFile2 = Dir
    Loop
    
'sor the array
    Call SortNumbers(Array2)
'
'if there is a difference make note of it
    For i = LBound(Array1) To UBound(Array1)
       If Array1(i) <> Array2(i) Then
         MsgBox Array1(i) & " <> " & Array2(i)
         Else
         MsgBox "Congratulations you've got it"
        End If
    Next
End Sub

[HeSaidJoe]

OK, I have your code but not your folders..zip then and email them to me so I can test your code.

Wayne

do it now cause I'm leaving work early today.

[kanejone]

I've sent a few samples to your yahoo account. Thanks JK

[HeSaidJoe]

'get the file sizes for all text files in folder two
    sDir2 = MyNewDir

should be
    sDir2 = MyNewDir & "\"

also you may want to remove the 
Msgbox Congratulations out of the loop
If you have 1000 files you will get 1000 msgboxes

Later.

[kanejone]

Thanks again. I can now rest. I only started VB about three and a half weeks ago. This was really bothering me, thanks a million for the help.

[HeSaidJoe]