Zipping files between date range

[zeee91]

Hello, I need help. i am trying to get the user to input a date and zip files between the date range. Any assistance would be helpful. Thank you in advance for looking at it.

Sub UserDate()
  Dim strDate As Date, endDate As Date, DateRange As String
  
  strDate = InputBox("Insert start date in format dd/mm/yy", "Start Date", Format(Now(), "dd/mm/yy"))
  endDate = InputBox("Insert end date in format dd/mm/yy", "End Date", Format(Now(), "dd/mm/yy"))
  DateRange = "[Date] BETWEEN #" & strDate & "# AND #" & endDate & "#"
  
  If IsDate(strDate) And IsDate(endDate) Then
    strDate = Format(CDate(strDate), "dd/mm/yy")
    endDate = Format(CDate(strDate), "dd/mm/yy")
    MsgBox "Date Range: " & strDate & "-" & endDate
    
  Else
    MsgBox "Wrong date format"
  End If
End Sub


Sub CreateZipFile(sPath As Variant, zipName As Variant)

Dim ShellApp As Object
Dim MyObj As Object, MySource As Object, file As Variant
Dim sFile As String, sDate As String ', sPath As String

'Call UserDate(strDate, endDate, DateRange)
 
 sDate = Year(Now()) & "-" & Month(Now()) & "-" & Day(Now())
 sPath = DLookup("FilePathName", "tblProperties", "[ID] = 1")
 'sFile = .Fields("CUSTOMER_NAME").Value & "Inv" & .Fields("INVOICE_NUMBER").Value & "_" & .Fields("VENDOR_NAME").Value & "_" & sDate & ".pdf"
 cusName = Left([sFile], Find("Inv") - 1) 'And Where invoice_date= DateRange

 zipName = cusName & sDate & ".zip"
 
 While (sPath <> "")
 If InStr(sPath, "") > 0 Then
 
'Create an empty zip file
Open zipName For Output As #1
Print #1, Chr$(80) & Chr$(75) & Chr$(5) & Chr$(6) & String(18, 0)
Close #1
 
 If cusName = .Fields("CUSTOMER_NAME").Value Then
 
'Copy the files & folders into the zip file
Set ShellApp = CreateObject("Shell.Application")
ShellApp.Namespace(zipName).CopyHere ShellApp.Namespace(sPath).items
 
'Zipping files
On Error Resume Next
Do Until ShellApp.Namespace(zippedInvoices).items.Count = ShellApp.Namespace(sPath).items.Count
    Application.Wait (Now + TimeValue("0:00:01"))

Loop
On Error GoTo 0
 
 MsgBox "Created zip" & zipName
 
 End If
     file = Dir
  Wend

End Sub

[alansidman]

Administrative Note:

Welcome to the forum.

We would very much like to help you with your query, however you need to include code tags around your code.

Please take a moment to add the tags. Posting code between [CODE] [/CODE] tags makes your code much easier to read and copy for testing, and it also maintains VBA formatting.

Click on Edit to open your thread, then highlight your code and click the # icon at the top of your post window. More information about these and other tags can be found here


I have added them today, but in the future, you should be doing this.