X can be any number, we will start at 20 but maybe go higher.
My thoughts were to copy 20 to another folder, zip them, and delete those copies and repeat as necessary.
My code to do this is here:
Code: Select all
Option Compare Database
Public Declare PtrSafe Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
Sub ArchiveFiles()
Debug.Print Now
Dim intMaxFilesPerZip As Integer
intMaxFilesPerZip = GetFilesPerZip
Dim intFileCount As Integer
intFileCount = 0
'Copy that many to ToZip folder
Dim strNow As String
strNow = Format(Now, "yyyymmdd")
Dim strFileName As String
strFileName = Dir(CurrentDBDir & "Output\" & strNow & "\")
Do While strFileName <> ""
FileCopy CurrentDBDir & "Output\" & strNow & "\" & strFileName, CurrentDBDir & "Output\ToZip\" & strFileName
intFileCount = intFileCount + 1
If intFileCount = intMaxFilesPerZip Then
'Zip them and start counting again
CreateZipFile CurrentDBDir & "Output\ToZip\", CurrentDBDir & "Output\Zips\PR_BulkUpload_PS_" & Format(Now, "MMDDYYYYHHmmss") & ".zip"
Sleep 30000
intFileCount = 0
'Delete the files we just zipped
Kill CurrentDBDir & "Output\ToZip\*.*"
End If
strFileName = Dir()
Beep
Loop
'Zip the ones left
CreateZipFile CurrentDBDir & "Output\ToZip\", CurrentDBDir & "Output\Zips\PR_BulkUpload_PS_" & Format(Now, "MMDDYYYYHHmmss") & ".zip"
Sleep 30000
'Delete the files we just zipped
Kill CurrentDBDir & "Output\ToZip\*.*"
'Zip the inputs folder
CreateZipFile CurrentDBDir & "Inputs\", CurrentDBDir & "Archives\" & Format(Now, "YYYYMMDD") & "_Files.zip"
Sleep 30000
Debug.Print Now
MsgBox "Done!"
End Sub
Sub CreateZipFile(folderToZipPath As Variant, zippedFileFullName As Variant)
Dim ShellApp As Object
'Create an empty zip file
Open zippedFileFullName For Output As #1
Print #1, Chr$(80) & Chr$(75) & Chr$(5) & Chr$(6) & String(18, 0)
Close #1
'Copy the files & folders into the zip file
Set ShellApp = CreateObject("Shell.Application")
ShellApp.Namespace(zippedFileFullName).CopyHere ShellApp.Namespace(folderToZipPath).items
'Zipping the files may take a while, create loop to pause the macro until zipping has finished.
On Error Resume Next
Do Until ShellApp.Namespace(zippedFileFullName).items.Count = ShellApp.Namespace(folderToZipPath).items.Count
Sleep 1000
Loop
On Error GoTo 0
End Sub
Code: Select all
strFileName = Dir()
Suggestions?
Thanks!