-
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.
Code:
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???
Code:
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
-
<?>
where are you passing a value to MyNewDir
[Edited by HeSaidJoe on 09-21-2000 at 07:16 AM]
-
I'm doing that outside in a separate function
Code:
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
Code:
Do Until sFile = ""
seems to be still at 0 and it goes straight to the line
Code:
If UBound(fileArray2) > 0 Then
[Edited by kanejone on 09-21-2000 at 07:47 AM]
-
Please help
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
-
<?>
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
Code:
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
-
Thanks a lot for the code. I get a RunTime Error 9 :Subscript out of range: at the line.
Code:
For lLoop1 = UBound(iArray) To LBound(iArray) Step -1
What am I doing wrong. Thanks again. JK
-
<?>
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.
-
Thanks
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
-
<?>
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
-
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
Code:
'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
-
<?>
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.
-
I've sent a few samples to your yahoo account. Thanks JK
-
<?>
Code:
'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.
-
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.
-
<?>
